Excel-Makro liest Zip-Archiv direkt
Problembeschreibung
Sie bekommen regelmässig Daten, die Sie in Excel einlesen müssen, als Zip-Archiv zu geschickt und sind den Zwischenschritt leid, das Archiv nach dem Abspeichern noch zu entpacken, bevor es weiterverarbeitet werden kann?
Ihre Leseroutine holt sich den Dateinamen mit der Routine hole_DatenFileName().
Function hole_DatenFileName() As String
' Versuch auch Archive "direkt" zu lesen
Dim Dateiname As Variant
Dim Filter As String
Filter = "Daten-Dateien (*.dat), *.dat"
Dateiname = Application.GetOpenFilename(Filter)
If Dateiname = False Then
Dateiname = ""
End If
hole_DatenFileName = Dateiname
End Function
Lösung
Die Excel-VBA Lösung, die hier geschildert wird, erledigt dies beim Öffnen der Datei. Derzeitige Einschränkung: Es darf nur eine Datei im Archiv sein und es muss ein Zip-(und kein gZip-)Archiv sein .
Wenn dem Makro der Abspeicherungsort für das Dekomprimierungsprogramm bekannt ist, erweitert es den Datenfilter um die File-Extension "*.zip". Nach der Fileauswahl wird die Datei direkt geöffnet, um die ersten vier Bytes zu lesen.
Function hole_DatenFileName() As String
' Versuch auch Archive "direkt" zu lesen
Dim Dateiname As Variant
Dim Buffer As String
Dim Filter As String
Filter = "Daten-Dateien (*.dat), *.dat"
If Hole_Einstellung("Unzip") > "" Then
Filter = Filter & ", Archiv mit Daten (*.zip), *.zip"
End If
Dateiname = Application.GetOpenFilename(Filter)
If Dateiname = False Then
Dateiname = ""
Else
Open Dateiname For Binary Access Read As #1
Buffer = String(4, " ")
Get #1, , Buffer
Close #1
If Buffer = Chr$(80) & Chr$(75) & Chr$(3) & Chr$(4) Then ' ZIP-Format
Dateiname =
open_Archiv
(CStr(Dateiname))
'
If Dateiname = "" Then
Call MsgBox("Keine Datei im Archiv gefunden!", vbOKOnly + vbInformation)
End If
Else
flagArchiv = False
For counter = 1 To 4
If Mid$(Buffer, counter, 1) < " " Then ' Binäre Info unterhalb chr$(32) gefunden?
flagArchiv = True
End If
Next counter
'
If flagArchiv Then
Call MsgBox("Falsches Archiv-Format gefunden!", vbCritical + vbOKOnly)
End If
End If
End If
hole_DatenFileName = Dateiname
End Function
Wenn diese ersten vier Bytes die magischen Werte für Zip-Archive beinhalten, wird in der Routine open_ArchiveZIP das Archiv geprüft (nur eine Datei?) und die Datei auf einem temporären Verzeichnis entpackt. Dieser Dateiname wird danach anstatt des Archiv-Namens der eigentlichen Leseroutine übergeben.
Function open_Archiv(ArchivName As String) As String
Dim zeile As String
Dim FileInfoLine As String
Dim LastLine As String
Dim counter As Integer
Dim Ergebnis As Variant
Dim PathTemp As String
Dim PathUnZip As String
Const TmpFilename As String = "TMP_WORK.TXT"
Const TmpCommand As String = "TMP_WORK.CMD"
'
PathUnZip = appendSlash(Hole_Einstellung("Unzip"))
If Dir(PathUnZip & "unzip.exe") = "" Then
open_Archiv = "" ' Ohne Programm wird das leider nichts
Exit Function
End If
'
If Len(Environ("TEMP")) > 0 Then
PathTemp = Environ("TEMP")
ElseIf Len(Environ("TMP")) > 0 Then
PathTemp = Environ("TMP")
Else
PathTemp = "." ' Absoluter Notfall
End If
PathTemp = appendSlash(PathTemp)
'
loescheTemporaereDatei (PathTemp & TmpFilename)
loescheTemporaereDatei (PathTemp & TmpCommand)
'
' ACHTUNG: Lange Filenamen
' funktioniert mit folgender UNZIP-Version
' 29.11.98 01:50 139.264 UNZIP.EXE
' unzip -?
' UnZip 5.40 of 28 November 1998, by Info-ZIP. Maintained by C. Spieler. Send
' bug reports to the authors at Zip-Bugs@lists.wku.edu; see README for details.
'
' Ausgabeformat
' Archive: rp40020260_20020906.zip
' Length Date Time Name
' -------- ---- ---- ----
' 1291956 09-09-02 12:41 rp40020260_20020906.dat
' -------- -------
' 1291956 1 file
'
' Anmerkung zum SHELL Befehl:
' Leider interpretiert COMMAND.COM Paratmeter für das aufgerufene Programm als an sich gerichtet.
' Deshalb muss ein separate Datei geschrieben werden.
'
Open PathTemp & TmpCommand For Output As #1
Print #1, PathUnZip & "unzip.exe -l " & ArchivName & " >" & PathTemp & TmpFilename
Close #1
Ergebnis = Shell(PathTemp & TmpCommand)
Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 2)
On Error GoTo 0
'
' Archivlisting einlesen
'
Open PathTemp & TmpFilename For Input As 1
counter = 0
While Not EOF(1)
Line Input #1, zeile
counter = counter + 1
LastLine = zeile
If counter = 4 Then
FileInfoLine = zeile
End If
Wend
Close 1
'
' Abfrage: Nur ein File ?
'
If (Right$(LastLine, 6) = "1 file") And (InStr(FileInfoLine, " ") > 0) Then
counter = Len(FileInfoLine)
While Mid$(FileInfoLine, counter, 1) <> " "
counter = counter - 1
Wend
FileInfoLine = Mid$(FileInfoLine, counter + 1)
Open PathTemp & TmpCommand For Output As #1
Print #1, PathUnZip & "unzip.exe " & ArchivName & " -d " & PathTemp
Close #1
Ergebnis = Shell(PathTemp & TmpCommand)
Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 2)
open_Archiv = PathTemp & FileInfoLine
Else
open_Archiv = ""
End If
'
loescheTemporaereDatei (PathTemp & TmpFilename)
loescheTemporaereDatei (PathTemp & TmpCommand)
'
End Function
Leider kann man nicht direkt mit dem Shell-Command von Excel-VBA arbeiteten, weil die Parameter für das Unzip-Programm als Parameter für den Befehlsinterpreter ausgewertet werden.
Jetzt benötigen Sie nur noch die Möglichkeit, den Ort vom Programm Unzip dauerhaft abzuspeichern. Dies wird mit einer relativ kurzen Routine in die (benutzerbezogene) Windows-Registry eingetragen.
Sub setze_unzip_verzeichnis()
Const GesuchtesProgramm As String = "unzip.exe"
Dim Filename As Variant
Dim Filter As String
'
Filter = "Programmdateien (*.exe), *.exe"
Filename = Application.GetOpenFilename(Filter, 1, "Gesucht wird " & GesuchtesProgramm)
If Filename <> False And Len(Filename) > Len(GesuchtesProgramm) Then
Filename = Left$(Filename, Len(Filename) - Len(GesuchtesProgramm) - 1)
Call Sichere_Einstellung("Unzip", CStr(Filename))
End If
End Sub
Datei(en)
Die Datei exczip.zip enthält den vollstädigen VBA-Code (inklusive der hier nicht aufgeführten Hilfsroutinen) für die Erweiterung der Routine hole_DatenFileName.
Das Archiv wurde am 14.01.07 bereinigt, da bei der Rückentwicklung eine Procedure nicht korrekt umbenannt wurde.
Hinweis
Fehler können auftreten, wenn in Ihren Verzeichnisnamen Umlaute vorhanden sind und der Zeichensatz vom MSDOS-Fenster nicht auf den Windows-Zeichensatz umgestellt ist.
Kommentare dazu sind -wie immer- erwünscht.
Weiterentwicklung der Routine ist in zwei Richtungen denkbar: