Excel VBA - 从.zip文件中读取.txt [英] Excel VBA - read .txt from .zip files

问题描述

我试图在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）
如果IsArray（Fname）= False然后
'不做任何
 Else 
'新文件夹的根文件夹。 
'您还可以使用DefPath =C：\Users\Ron\test\
 DefPath = Application.DefaultFilePath 
 
如果右（DefPath，1） <> \然后
 DefPath = DefPath& \
如果
 
对于每个fileNameInZip在oApp.Namespace（Fname）.Items 
如果LCase（fileNameInZip）像LCase（md5.txt）然后
 
'打开md5.txt输入为＃1 
'直到EOF（1）
'行输入＃1，textline 
'text = text& ; text = $（$，$）
 $ b'关闭＃1 
 
'范围（B1）。 ）.Value = Dir（Fname）
 End If 
 Next 
 End If 
 End Sub 
  

我不知道是否全部出错，我已经尝试制作一个循环，并打开每个压缩文件中的每个文件md5.txt，我必须打开并且采取什么内部的md5.txt

你可以帮我吗？谢谢。

解决方案

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

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

  Sub GetData（）
 Dim iRow As Integer'row counter 
 Dim iCol As Integer'column counter 
 Dim savePath As String'保存提取的文件的位置
 Dim fileContents As String'文件的内容
 Dim fso As FileSystemObject'FileSystemObject处理文件
 iRow = 1'从第一行开始
 iCol = 1'从frist列开始
'将保存路径设置为临时文件夹
 savePath = Environ（TEMP）
'创建文件系统对象
设置fso = New FileSystemObject 
 
尽管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 
循环
 
 
'释放内存
设置fso = Nothing 
 End Sub 
 
 
 
函数UnzipFile（savePath As String，zipName As String，fileName As String）As String 
 Dim oApp As Shell 
 Dim strFile As String 
'获取一个shell对象
设置oApp = CreateObject（Shell.Application）
'检查zip包含项目
如果oApp.Namespace（zipName）.Items。计数> 0然后
 Dim i As Integer 
'循环通过zip文件中的所有项目
对于i = 0到oApp.Namespace（zipName）.Items.Count  -  1 
'检查是否是txt文件
如果UCase（oApp.Namespace（zipName）.Items.Item（i））= UCase（filename）然后
'将文件保存到新位置
 oApp.Namespace（savePath）.CopyHere oApp.Namespace（zipName）.Items.Item（i）
'设置文件的位置
 UnzipFile = savePath& \& fileName 
'退出函数
退出函数
结束If 
 Next i 
 End If 
'free memory 
设置oApp = Nothing 
 
结束功能
  

I'm trying to make a macro in VBA,but I'm new in VBA.

I need to open a few .zip files, view a specific .txt and write what's inside of this .txt file to an excel, and the name of the .zip will be in the same row in excel, example:

The first row is the name of the .zip file and in the first row and second column will be the content of the .txt file.

I've have part of the code, but its not working its saying code error 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

I don't know if it's all wrong or not, I've try to make a loop and open every file md5.txt in every zip that I have to open and take what's inside of the md5.txt

Can you help me with this? Thanks.

解决方案

Here is an example of looping through your cells and getting the zip file, extracting the contents, and reading the file. You may need to adjust the path to the zip file or it will default to what ever file the excel document is started in. If you put the whole path to the zip in column A then you would not need to make an adjustment.

Edit was made to reflect the name of the file md5.txt and place contents in second column.

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

这篇关于Excel VBA - 从.zip文件中读取.txt的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！