Read the content of the Zip file(ex.txt) w

2019-04-14 20:08发布

问题:

I'm really new to Access VBA. I have a problem in Access code could you help me with a request mentioned below?

I have file with names like ex.zip. In this example, the Zip file contains only one file with the same name(ie. `ex.txt'), which is quite large file. I don't want to extract the zip file every time.Hence I need to read the content of the file(ex.txt) without extracting the zip file. I tried some code like below But i can't read the content of the file and can't stores the content in the variable in Access VBA.

How do I read the content of the file and stores it in the variable?

I have tried some code in VBA to read the zipped text But i didn't make any sense..

回答1:

Here's the code for zipping & unzipping. If you look at it the unzip part, you'll see where it reads the zip file like a directory. Then you can choose if you want to extract that file.

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