带有Shell应用程序的VBA“对象变量或未设置块变量”

Question

我正在尝试从一系列 zip 文件中提取一些数据，并将它们存储在我正在处理的同一张表中。我已经提取了每个 zip 文件的名称并将它们存储在工作表的一列中。我想遍历它们以提取我需要的数据，但是，当我访问 oApp.Namespace(zipName).Items 时，我不断收到“运行时错误 91”的错误。这是我拥有的VBA代码，有人可以帮我吗？谢谢！

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, "Device-1_IR_VR_7-16-2019-2-32-55_PM.pda-iv.txt"), ForReading).ReadAll
    ActiveSheet.Cells(iRow, iCol).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
    'Debug.Print oApp.Namespace(zipName).Items.Count
  If Not IsNull(oApp.Namespace(zipName).Items) Then
    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
   End If
'free memory
Set oApp = Nothing

End Function

Answer 1

如果要将变量传递给 Shell，请将它们交换为 Variant：

Sub GetData()
    Dim iRow As Long                'row counter
    Dim iCol As Long                'column counter
    Dim savePath As Variant         'place to save the extracted files
    Dim zipName As Variant
    Dim txtPath As String
    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 first column
    savePath = Environ("TEMP")      'set the save path to the temp folder
    Set fso = New FileSystemObject  'create the filesystem object
    
    Do While ActiveSheet.Cells(iRow, iCol).Value <> ""
        zipName = ActiveSheet.Cells(iRow, iCol).Value
        txtPath = UnzipFile(savePath, zipName, "Device-1_IR_VR_7-16-2019-2-32-55_PM.pda-iv.txt")
        If Len(txtPath) > 0 Then 'if found the file...
            fileContents = fso.OpenTextFile(txtPath, ForReading).ReadAll
            ActiveSheet.Cells(iRow, iCol).Value = fileContents
        End If
        iRow = iRow + 1
    Loop
End Sub

Function UnzipFile(savePath As Variant, zipName As Variant, fileName As String) As String
    Dim oApp As Object, ns As Object, i As Long
    
    Set oApp = CreateObject("Shell.Application")    'get a shell object
    Set ns = oApp.Namespace(zipName)                'get the zip namespace
    If ns.Items.Count > 0 Then
        For i = 0 To ns.Items.Count - 1
            'check to see if it is the txt file
            If UCase(ns.Items.Item(i)) = UCase(fileName) Then
                'save the files to the new location
                oApp.Namespace(savePath).CopyHere ns.Items.Item(i)
                UnzipFile = savePath & "\" & fileName 'return the location of the file
                Exit Function
            End If
        Next i
    End If
End Function