Excel VBA HTML导入格式

如何解决Excel VBA HTML导入格式

我一直在从另一个线程使用以下vba，并将其修改为允许html vs txt。

导入HTML时可以正常工作，但html分散在多行中，而不包含在一个单元格中。

有没有一种方法可以将html限制为仅一次单元格？

我需要将所有html放在一个单元格中，因为我需要定期处理大约500个html文件，而我只需要将其放在单个单元格中即可。

任何帮助表示赞赏。

Sub ImportTXTFiles()
Dim FSO As Object
Dim xlsheet As Worksheet
Dim qt As QueryTable
Dim txtfilesToOpen As Variant,txtfile As Variant

Application.ScreenUpdating = False
Set FSO = CreateObject("Scripting.FileSystemObject")

txtfilesToOpen = Application.GetOpenFilename _
             (FileFilter:="Text Files (*.html),*.html",_
              MultiSelect:=True,Title:="HTML Files to Open")

With ActiveSheet

    For Each txtfile In txtfilesToOpen

        importrow = 1 + .Cells(.Rows.Count,1).End(xlUp).Row

        ' IMPORT DATA FROM TEXT FILE
        With .QueryTables.Add(Connection:="TEXT;" & txtfile,_
          Destination:=.Cells(importrow,1))
         
            .TextFileParseType = xlDelimited
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileOtherDelimiter = "$"
            .Refresh BackgroundQuery:=False
        End With


    Next txtfile

    For Each qt In .QueryTables
        qt.Delete
    Next qt

End With

Application.ScreenUpdating = True
MsgBox "Successfully imported text files!",vbInformation,"SUCCESSFUL IMPORT"

Set FSO = Nothing

结束子

解决方法

请尝试下一个代码，

Sub ImportTXTFiles()
 Dim FSO As Object,txtStr As Object,strText As String,sh As Worksheet
 Dim txtfilesToOpen As Variant,txtfile As Variant,importrow As Long

 Set FSO = CreateObject("Scripting.FileSystemObject")
 Set sh = ActiveSheet ' use here your sheet
 
 txtfilesToOpen = Application.GetOpenFilename _
             (FileFilter:="Text Files (*.html),*.html",_
              MultiSelect:=True,Title:="HTML Files to Open")

    For Each txtfile In txtfilesToOpen
        importrow = 1 + sh.cells(Rows.count,1).End(xlUp).Row
        Set txtStr = FSO.OpenTextFile(txtfile)
            strText = txtStr.ReadAll
        txtStr.Close
        If Len(strText) <= 32000 Then
            sh.cells(importrow,1).Value = strText:
        Else
            MsgBox txtfile & " size exceeds the limit of 32000 digits..."
        End If

    Next txtfile

 MsgBox "Successfully imported text files!",vbInformation,"SUCCESSFUL IMPORT"

 Set FSO = Nothing
End Sub

它检查单元格字符串大小的限制（32k个字符），并在这种情况下显示一条消息...如有必要，可以将字符串分成32k部分并粘贴到下一个单元格中，在B中标记： B 1，2 ... x部分编号...