Kopieren in ZIP-Archiv - LZF 91
07.02.2019 14:46:39
Ingo
ich beiße mir nun schon seit TAGEN die Zähne an einem Laufzeitfehler Problem aus und komme einfach nicht mehr weiter. Die Suche im Netz und auch hier im Forum hat mich zwar auf verschiedene Ideen gebracht, aber ich bekomme es nicht so richtig zum Laufen. Ich benötige daher dringend Unterstützung von Spezialisten auf dem Gebiet der VBA-Programmierung
Beschreibung:
Ich bin dabei ein recht umfangreiches Tool zu erstellen und arbeite hier schon einige Monate dran. Die wesentlichen Funktionen laufen bereits sehr gut und auch zuverlässig. Zu Dokumentationszwecken müssen aber ein paar Informationen in verschiedene Textdateien abgelegt werden und diese zusammen in den Ordner "Final-go" gelegt werden. Zu guter letzt wird noch ein ZIP-Archiv "Final-Change" angelegt. Bis hierher funktioniert alles prima!
Als letzter Schritt der Aufgabe soll der Inhalt des Ordners "Final-go" in das ZIP-Archiv "Final-Change" kopiert werden. Das will ich mit folgender Code-Zeile machen:
oApp.Namespace(filenameZip).CopyHere oApp.Namespace(foldername).items
Aufgrund von Einschränkungen bei meinem Arbeitgeber kann kein WinZip installiert werden undd ich bin auf Windows Bordmittel angewiesen. Daher der Umweg über die Shell. Falls von Interesse: zurzeit arbeite ich (noch) mit Windows 7. Eine Migration auf W10 steht vsl. bis Jahresende an.
Als Parameter übergebe ich ein Array mit den zu sammelnden bzw. zu dokumentarisierenden Dateien.
Problem:
Zur Laufzeit des Skriptes wird der Fehlercode 91 "Objektvariable oder With-Blockvariable nicht festgelegt" ausgegeben.
Aus meiner Sicht ist allerdings die Objektvariable einwandfrei deklariert und auch die Set-Anweisung zuvor funktioniert einwandfrei. Eine With-Anweisung verwende ich in diesem Kontext nicht, kann also auch nicht zu einem Fehler führen?! Wo ist hier mein Gedankenfehler?!?!
Mein aktueller Code:
Hier noch etwas Code. Die wesentlichen Dinge habe ich kommentiert, damit klar wird, was ich bezwecken will:
Function func_create_zip_file(arr_go_array() As String)
Dim txtfile As String
Dim file As String
Dim filename As String
Dim filenameTmp As String
Dim filenameZip As String
Dim foldername As String
Dim path As String
Dim fc_path As String
Dim strDate As String
Dim var_go_counter As Integer
Dim int_Channel As Integer
Dim i_go As Integer
Dim oApp As Object ' Deklaration der Objektvariablen!
var_go_counter = UBound(arr_go_array, 1)
int_Channel = FreeFile
strDate = Format(Now, "yyyymmdd")
path = ActiveWorkbook.path
fc_path = path & "\Final Change"
int_Channel = FreeFile
txtfile = path & "\" & file
Open txtfile For Output Shared As #int_Channel
i_go = 1
If arr_go_array(i_go) "" Then
' Der ges. Code wird nur dann ausgeführt, wenn mind. ein Wert im Array übergeben wird
ChDir path
If Right(path, 1) "\" Then
path = path & "\"
End If
If FileFolderExists("Final go") Then
' keine Aktion wenn der Ordner existiert. Andernfalls Ordner anlegen
Else
MkDir "Final go"
End If
For i_go = 1 To var_go_counter
If arr_go_array(i_go) "" Then
filenameTmp = path & "Final go\" & arr_go_array(i_go) & ".txt" ' --> == _
Filename: aus arr_go_array
filename = path & arr_go_array(i_go) & ".txt" ' --> == Filename: aus _
arr_go_array; Pfad anders!
FileCopy filename, filenameTmp
Else
End If
Next i_go
Else
' wenn das erste Feld im Array = "" ist (kein Wert enthalten) wird _
weder ein Ordner mit Namen "Final go" angelegt, noch Dateien kopiert!
End If
filenameZip = path & "Final-Change" & ".zip" '
foldername = path & "Final go\"
' Neues ZIP-Archiv erstellen
NewZip (filenameZip) ' Code zu "NewZip": s. u.
Set oApp = CreateObject("Shell.Application") 'läuft!
' Dateien aus dem Ordner "Final-go" in das ZIP-Archiv "Final-Change" kopieren
oApp.Namespace(filenameZip).CopyHere oApp.Namespace(foldername).items
On Error Resume Next
' Prüft ob alle Dateien kopiert wurden
Do Until oApp.Namespace(filenameZip).items.Count = _
oApp.Namespace(foldername).items.Count
Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0
ChDir foldername
If Dir("*.*") "" Then
' Kill foldername + "*.*"
MsgBox "Kill foldername :-)"
End If
' VBA.Interaction.Shell.Application
' Ausgabe der Dok mit print #int_channel ...
End Function
Sub NewZip(ZipFile)
Dim Lenght As String
Dim strDate As String
Dim path
path = ActiveWorkbook.path
ChDir path
'Create empty Zip File
'Changed by keepITcool Dec-12-2005
If Len(Dir(ZipFile)) > 0 Then Kill ZipFile
'Kill ZipFile
Open ZipFile For Output As #2
Print #2, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #2
End Sub
VG
Ingo