2

我真的是 Access VBA 的新手。我的访问代码有问题，您能帮我解决下面提到的请求吗？

我的文件名称如ex.zip. 在本例中，Zip 文件只包含一个同名文件（即 `ex.txt'），这是一个相当大的文件。我不想每次都提取 zip 文件。因此我需要在不提取 zip 文件的情况下读取文件的内容（ex.txt）。我尝试了一些类似下面的代码但我无法读取文件的内容，也无法将内容存储在 Access VBA 的变量中。

如何读取文件的内容并将其存储在变量中？

我在 VBA 中尝试了一些代码来阅读压缩文本但我没有任何意义..

4

1 回答 1

0

这是压缩和解压缩的代码。如果您查看它的解压缩部分，您会看到它像目录一样读取 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
于 2013-02-20T19:03:22.427 回答