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

我想在VBA中创build一个macros，但我是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 

我不知道是否全错，我试着做一个循环，打开每个zip文件中的每个文件md5.txt，然后打开md5.txt文件

你能帮我吗？ 谢谢。

Answer 1

下面是一个循环遍历你的单元格和获取压缩文件，提取内容，并阅读文件的例子。 您可能需要调整到zip文件的path，否则它将默认启动excel文档。如果将整个path放在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