从 .zip 文件中读取 .txt

Question

我需要打开几个 .zip 文件，查看特定的 .txt 并将此 .txt 文件中的内容写入 Excel 工作簿，.zip 的名称将在 Excel 中的同一行中。

例子：

第一行是 .zip 文件的名称，第一行第二列是 .txt 文件的内容。

我有部分代码。它显示代码错误 91。

Sub Text()
    Dim FSO As Object
    Dim oApp As Object
    Dim Fname As Variant
    Dim FileNameFolder As Variant
    Dim DefPath As String
    Dim strDate As String
    Dim I As Long
    Dim num As Long

    Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
                                        MultiSelect:=True)
    If IsArray(Fname) = False Then
        'Do nothing
    Else
        'Root folder for the new folder.
        'You can also use DefPath = "C:\Users\Ron\test\"
        DefPath = Application.DefaultFilePath

        If Right(DefPath, 1) <> "\" Then
            DefPath = DefPath & "\"
        End If

        For Each fileNameInZip In oApp.Namespace(Fname).Items
            If LCase(fileNameInZip) Like LCase("md5.txt") Then

                'Open "md5.txt" For Input As #1
                'Do Until EOF(1)
                'Line Input #1, textline
                 '   text = text & textline
               ' Loop
               ' Close #1

               ' Range("B1").Value = Mid(text, 1, 32)
               ' Range("A1").Value = Dir(Fname)
            End If
        Next
    End If
End Sub

我尝试创建一个循环来打开我必须打开的每个 zip 中的每个文件 md5.txt 并获取 md5.txt 中的内容

Answer 1

这是一个循环遍历单元格并获取 zip 文件、提取内容并读取文件的示例。您可能需要调整 zip 文件的路径，否则它将默认为启动 excel 文档的任何文件。如果您将 zip 的整个路径放在 A 列中，则无需进行调整。

进行了编辑以反映文件 md5.txt 的名称并将内容放在第二列中。

Sub GetData()
Dim iRow As Integer 'row counter
Dim iCol As Integer 'column counter
Dim savePath As String 'place to save the extracted files
Dim fileContents As String 'contents of the file
Dim fso As FileSystemObject 'FileSystemObject to work with files
iRow = 1 'start at first row
iCol = 1 'start at frist column
'set the save path to the temp folder
savePath = Environ("TEMP")
'create the filesystem object
Set fso = New FileSystemObject

Do While ActiveSheet.Cells(iRow, iCol).Value <> ""
    fileContents = fso.OpenTextFile(UnzipFile(savePath, ActiveSheet.Cells(iRow, iCol).Value, "md5.txt"), ForReading).ReadAll
    ActiveSheet.Cells(iRow, iCol + 1).Value = fileContents
    iRow = iRow + 1
Loop


'free the memory
Set fso = Nothing
End Sub



Function UnzipFile(savePath As String, zipName As String, fileName As String) As String
Dim oApp As Shell
Dim strFile As String
'get a shell object
Set oApp = CreateObject("Shell.Application")
    'check to see if the zip contains items
    If oApp.Namespace(zipName).Items.Count > 0 Then
        Dim i As Integer
        'loop through all the items in the zip file
        For i = 0 To oApp.Namespace(zipName).Items.Count - 1
            'check to see if it is the txt file
            If UCase(oApp.Namespace(zipName).Items.Item(i)) = UCase(filename) Then
                'save the files to the new location
                oApp.Namespace(savePath).CopyHere oApp.Namespace(zipName).Items.Item(i)
                'set the location of the file
                UnzipFile = savePath & "\" & fileName
                'exit the function
                Exit Function
            End If
        Next i
    End If
'free memory
Set oApp = Nothing

End Function