Excel VBA - 从.zip文件读取.txt

Question

我想在VBA中创建一个宏，但我是VBA中的新成员。

我需要开几个.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 

我不知道，如果这一切都错了还是不行，我已经尝试做一个循环，打开每个文件中的每个文件md5.txt，我必须打开并采取md5.txt中的内容

你能帮助我吗？谢谢。

Answer 1

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

编辑是为了反映文件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