Question

我是Access VBA的新手。我在访问代码中遇到问题你可以帮我解决下面提到的请求吗？

我的文件名为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

在不解压缩zip文件的情况下读取Zip文件（ex.txt）的内容

1 个答案: