在Excel vba中操作.htm文件

我正在尝试用Excel vba制作一个应用程序，但我遇到了一些问题。我需要我的Excel应用程序下载一些zip格式的文件。我已经解决了这部分问题，我的应用程序可以下载和解压文件。接下来，我将阅读扩展名为.htm的整个文件，并从中获取一些信息。它需要这样工作，当应用程序被打开时，程序应该在Basil中查找竞赛的最后一个数字，即“concurso”，然后在.htm文件中查找相同的数字，并开始复制下一个数据

我已经发现了一种读取文件并获取所需数据的模式，但我不知道如何为其编码。要提取的.htm文件中的模式是在标签td内，一个有2个斜杠的文本，因此，我有一个日期，此时，我必须做3件事，获取日期，日期上方的行我有concurso的编号，所以我也需要获取它，日期下方的15行我也需要15个数字。此模式不会更改，必须一直处理到.htm文件结束。并将这些数据传输到我的工作表中，以便以后处理

如果对该问题有疑问，我将进一步澄清。
这是我用来下载和解压文件的代码。↓

Sub DownloadEUnzip()
    Dim FSO, oApp As Object
    Dim objHttp, DefPath, Arquivo As String
    Dim Dados() As Byte
    Dim Fname As Variant
    Dim FileNameFolder As Variant
    Dim iFileNumber As Long

    Dim diretorio As String

    diretorio = Dir("c:\lotofacil\D_LOTFAC.HTM")

    If diretorio = "D_LOTFAC.HTM" Then
        Kill "C:\lotofacil\*"
    End If

    Set objHttp = CreateObject("MSXML2.ServerXMLHTTP")
    objHttp.Open "GET", "http://www1.caixa.gov.br/loterias/_arquivos/loterias/D_lotfac.zip", False
    objHttp.Send
    DefPath = "C:\lotofacil\" '<<< Altere aqui
    Arquivo = DefPath & "D_lotfac.zip"
    If objHttp.Status = "200" Then
        Dados = objHttp.ResponseBody
        iFileNumber = FreeFile
        Open Arquivo For Binary Access Write As #iFileNumber
        Put #iFileNumber, 1, Dados
        Close #iFileNumber
    End If
    If Right(DefPath, 1) <> "\" Then
        DefPath = DefPath & "\"
    End If
    FileNameFolder = DefPath

    Set oApp = CreateObject("Shell.Application")
    oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace("C:\lotofacil\D_lotfac.zip").items
    MsgBox "Arquivos baixados e descompactados com sucesso!"
End Sub

更新2

caio，现在速度真的很快，但在我使用的时候，我注意到程序使用的列少于需要的列，我更改了代码，它显然可以工作……想让你看看我是否没有弄糟。。。 我更改了数组的大小，看起来它可以工作：）看一看

Sub ReadLines()

Dim dataArray() As String
Dim strText
Dim result As String
Dim regExDate As New RegExp, regExAnyContent As New RegExp
Dim matches As MatchCollection
Dim match As match
Dim previous As String, current As String
Dim currentLine As Integer
ReDim dataArray(17, 1000)

regExDate.Pattern = "(\d{2}/\d{2}/\d{4})"
regExAnyContent.Pattern = "<td[^>]*>([^<]*)"
dirPath = "c:\lotofacil\"
filePath = dirPath & "D_LOTFAC.HTM"
result = ""
currentLine = 0

If Not Dir(filePath) = "D_LOTFAC.HTM" Then Exit Sub
FileNum = FreeFile()

Open filePath For Input As #FileNum
previous = ""

While Not EOF(FileNum)
    Line Input #FileNum, current ' read in data 1 line at a time

    If Len(current) > 0 Then
        Set matches = regExDate.Execute(current)
        If matches.Count > 0 Then
            dataArray(1, currentLine) = matches.Item(0)
            dataArray(0, currentLine) = regExAnyContent.Execute(previous).Item(0).SubMatches(0)
            For i = 1 To 16
                Line Input #FileNum, current
                While current = ""
                    Line Input #FileNum, current
                Wend
                dataArray(1 + i, currentLine) = regExAnyContent.Execute(current).Item(0).SubMatches(0)
            Next
            currentLine = currentLine + 1
            If currentLine Mod 1000 = 0 Then
                ReDim Preserve dataArray(17, currentLine + 1000)
            End If
        End If
        previous = current
    End If


    ' decide what to do with dataline,
    ' depending on what processing you need to do for each case
Wend

Range(Cells(1, 1), Cells(currentLine, 17)) = Application.Transpose(dataArray)

End Sub

子读取行（）
Dim dataArray（）作为字符串
暗文本
将结果变暗为字符串
Dim regExDate作为新RegExp，regExAnyContent作为新RegExp
将匹配项设置为MatchCollection
暗配
将上一个设置为字符串，将当前设置为字符串
将currentLine设置为整数
ReDim数据阵列（17，1000）
regExDate.Pattern=“（\d{2}/\d{2}/\d{4}）”
regExAnyContent.Pattern=“]*>（[^尝试此操作将文件读取到剪贴板并将其内容粘贴到工作表中，这将创建一个您可以使用的普通Excel表

这将使用excel的自然功能将html表解析为常规excel表

Sub ReadFilePasteAsTable()
Dim objData As New MSForms.DataObject
Dim strText
Dim result As String
Dim numberOfLines Integer
Dim wsh As Object
Set wsh = VBA.CreateObject("WScript.Shell")


numberOfLines = 126
dirPath = "c:\lotofacil\"
diretorio = Dir(dirPath & "D_LOTFAC.HTM")
result = ""

If Not diretorio = "D_LOTFAC.HTM" Then Exit Sub
FileNum = FreeFile()

filePath = dirPath & "D_LOTFAC.HTM"
outPath = dirPath & "out.txt"
pscommand = "Powershell -Command ""''+$(cat " & filePath & " -Tail 126) > " & outPath & """"
wsh.Run pscommand, 0, True

Open outPath For Input As #FileNum

While Not EOF(FileNum)
    Line Input #FileNum, DataLine ' read in data 1 line at a time
    result = result & DataLine
    ' decide what to do with dataline,
    ' depending on what processing you need to do for each case
Wend

    objData.SetText result
    objData.PutInClipboard

ActiveSheet.Paste Destination:=[A1]
End Sub
看看通过VBA使用Internet Explorer，有几种方法，只需在流中打开文件进行读取，然后使用split on，或者通过IE打开并使用GetElementsByTagName（“TD”）请通读，并向我们展示您迄今为止尝试过的内容。请在此处张贴代码。我和我打赌其他人不会从internet下载文件，尤其是在可能涉及宏的情况下。谢谢caio的帮助，但我如何添加此参考，因为在vb.net上尝试过使用关键字“导入”，但它不会工作：/谢谢你，伙计，我也已经得到了，在网上看了看，它只是在项目上放了一个表格，它添加了我们需要的参考资料。它满足了你的需要吗？所以Caio，我正在努力改进代码，因为我需要它每周更新3次，我需要的只是从上一页开始的更新，所以你帮了我很多如果你想解决这个问题，我会理解；）是的，你的代码工作正常，但我正在努力改进，因为它需要很多时间才能运行，但正如我所说的，谢谢你的帮助，欢迎更多的帮助：）
Sub ReadFilePasteAsTable()
Dim objData As New MSForms.DataObject
Dim strText
Dim result As String
Dim numberOfLines Integer
Dim wsh As Object
Set wsh = VBA.CreateObject("WScript.Shell")


numberOfLines = 126
dirPath = "c:\lotofacil\"
diretorio = Dir(dirPath & "D_LOTFAC.HTM")
result = ""

If Not diretorio = "D_LOTFAC.HTM" Then Exit Sub
FileNum = FreeFile()

filePath = dirPath & "D_LOTFAC.HTM"
outPath = dirPath & "out.txt"
pscommand = "Powershell -Command ""''+$(cat " & filePath & " -Tail 126) > " & outPath & """"
wsh.Run pscommand, 0, True

Open outPath For Input As #FileNum

While Not EOF(FileNum)
    Line Input #FileNum, DataLine ' read in data 1 line at a time
    result = result & DataLine
    ' decide what to do with dataline,
    ' depending on what processing you need to do for each case
Wend

    objData.SetText result
    objData.PutInClipboard

ActiveSheet.Paste Destination:=[A1]
End Sub
Sub ReadLines()
Dim dataArray() As String
Dim strText
Dim result As String
Dim regExDate As New RegExp, regExAnyContent As New RegExp
Dim matches As MatchCollection
Dim match As match
Dim previous As String, current As String
Dim currentLine As Integer
ReDim dataArray(16, 1000)

regExDate.Pattern = "(\d{2}/\d{2}/\d{4})"
regExAnyContent.Pattern = "<td[^>]*>([^<]*)"
dirPath = "c:\lotofacil\"
filePath = dirPath & "D_LOTFAC.HTM"
result = ""
currentLine = 0

If Not Dir(filePath) = "D_LOTFAC.HTM" Then Exit Sub
FileNum = FreeFile()

Open filePath For Input As #FileNum
previous = ""

While Not EOF(FileNum)
    Line Input #FileNum, current ' read in data 1 line at a time

    If Len(current) > 0 Then
        Set matches = regExDate.Execute(current)
        If matches.Count > 0 Then
            dataArray(1, currentLine) = matches.Item(0)
            dataArray(0, currentLine) = regExAnyContent.Execute(previous).Item(0).SubMatches(0)
            For i = 1 To 15
                Line Input #FileNum, current
                While current = ""
                    Line Input #FileNum, current
                Wend
                dataArray(1 + i, currentLine) = regExAnyContent.Execute(current).Item(0).SubMatches(0)
            Next
            currentLine = currentLine + 1
            If currentLine Mod 1000 = 0 Then
                ReDim Preserve dataArray(16, currentLine + 1000)
            End If
        End If
        previous = current
    End If


    ' decide what to do with dataline,
    ' depending on what processing you need to do for each case
Wend



Range(Cells(1, 1), Cells(currentLine, 16)) = Application.Transpose(dataArray)
End Sub