閱讀壓縮文件（ex.txt）的內容而不解壓zip文件

Question

我真的是Access VBA的新手。在Access代碼中有一個問題，你可以幫我處理下面提到的請求嗎？

我有一個名稱爲ex.zip的文件。在這個例子中，Zip文件只包含一個具有相同名稱的文件（即`ex.txt'），這是一個非常大的文件。我不想每次都提取zip文件。因此，我需要在不解壓zip文件的情況下閱讀文件的內容（ex.txt）。我嘗試了下面的一些代碼但是我無法讀取文件的內容，也無法將內容存儲在Access VBA中的變量中。

如何讀取文件的內容並將其存儲在變量中？

我曾嘗試在VBA一些代碼讀取壓縮文字，但我沒有任何意義..

Answer 1

下面是荏苒&解壓碼。如果你看看它的解壓縮部分，你會看到它像目錄一樣讀取zip文件的位置。然後，您可以選擇是否要提取該文件。

Private Declare Sub Sleep Lib "kernel32" (_ 
    ByVal dwMilliseconds As Long _ 
) 

Public Sub Zip(_ 
    ZipFile As String, _ 
    InputFile As String _ 
) 
On Error GoTo ErrHandler 
    Dim FSO As Object 'Scripting.FileSystemObject 
    Dim oApp As Object 'Shell32.Shell 
    Dim oFld As Object 'Shell32.Folder 
    Dim oShl As Object 'WScript.Shell 
    Dim I As Long 
    Dim l As Long 

    Set FSO = CreateObject("Scripting.FileSystemObject") 
    If Not FSO.FileExists(ZipFile) Then 
     'Create empty ZIP file 
     FSO.CreateTextFile(ZipFile, True).Write "PK" & Chr(5) & Chr(6) & String(18, vbNullChar) 
    End If 

    Set oApp = CreateObject("Shell.Application") 
    Set oFld = oApp.NameSpace(CVar(ZipFile)) 
    I = oFld.Items.Count 
    oFld.CopyHere (InputFile) 

    Set oShl = CreateObject("WScript.Shell") 

    'Search for a Compressing dialog 
    Do While oShl.AppActivate("Compressing...") = False 
     If oFld.Items.Count > I Then 
      'There's a file in the zip file now, but 
      'compressing may not be done just yet 
      Exit Do 
     End If 
     If l > 30 Then 
      '3 seconds has elapsed and no Compressing dialog 
      'The zip may have completed too quickly so exiting 
      Exit Do 
     End If 
     DoEvents 
     Sleep 100 
     l = l + 1 
    Loop 

    ' Wait for compression to complete before exiting 
    Do While oShl.AppActivate("Compressing...") = True 
     DoEvents 
     Sleep 100 
    Loop 

ExitProc: 
    On Error Resume Next 
     Set FSO = Nothing 
     Set oFld = Nothing 
     Set oApp = Nothing 
     Set oShl = Nothing 
    Exit Sub 
ErrHandler: 
    Select Case Err.Number 
     Case Else 
      MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Unexpected error" 
    End Select 
    Resume ExitProc 
    Resume 
End Sub 

Public Sub UnZip(_ 
    ZipFile As String, _ 
    Optional TargetFolderPath As String = vbNullString, _ 
    Optional OverwriteFile As Boolean = False _ 
    ) 
    'On Error GoTo ErrHandler 
    Dim oApp As Object 
    Dim FSO As Object 
    Dim fil As Object 
    Dim DefPath As String 
    Dim strDate As String 

    Set FSO = CreateObject("Scripting.FileSystemObject") 
    If Len(TargetFolderPath) = 0 Then 
     DefPath = CurrentProject.Path & "\" 
    Else 
     If Not FSO.FolderExists(TargetFolderPath) Then 
     MkDir TargetFolderPath 
     End If 
    DefPath = TargetFolderPath & "\" 
    End If 

    If FSO.FileExists(ZipFile) = False Then 
     MsgBox "System could not find " & ZipFile & " upgrade cancelled.", vbInformation, "Error Unziping File" 
     Exit Sub 
    Else 
    'Extract the files into the newly created folder 
    Set oApp = CreateObject("Shell.Application") 

    With oApp.NameSpace(ZipFile & "\") 
     If OverwriteFile Then 
     For Each fil In .Items 
      If FSO.FileExists(DefPath & fil.Name) Then 
       Kill DefPath & fil.Name 
      End If 
     Next 
     End If 
     oApp.NameSpace(CVar(DefPath)).CopyHere .Items 
    End With 

    On Error Resume Next 
    Kill Environ("Temp") & "\Temporary Directory*" 

    'Kill zip file 
    Kill ZipFile 
    End If 

ExitProc: 
    On Error Resume Next 
    Set oApp = Nothing 
    Exit Sub 
ErrHandler: 
    Select Case Err.Number 
     Case Else 
     MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Unexpected error" 
    End Select 
    Resume ExitProc 
    Resume 
End Sub