2

私はVBAにアクセスするのは本当に初めてです。アクセス コードに問題があります。下記のリクエストを手伝ってもらえますか?

のような名前のファイルがありますex.zip。この例では、Zip ファイルには同じ名前 (つまり、「ex.txt」) を持つファイルが 1 つだけ含まれており、これは非常に大きなファイルです。毎回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 に答える