Hallo liebe Forengemeinde,
ich habe folgendes Problem. In einem VBA Script habe ich folgenden Code
Const str7Zip As String = """C:\Users\Marco\Desktop\Rahmenvertrag Tool\7ZipPortable\App\7Zip\7z.exe"""
Ziel ist es jedoch die Pfadangabe variabel zu gestalten, d.h. ich möchte den Pfad beginnen dort wo die Exceldatei liegt und die Pfadangabe endet dann ...7ZipPortable\App\7Zip\7z.exe
Ich habe hier nun schon einiges versucht, bekomme aber keine Lösung hin. Der oben aufgeführte Code funktioniert jedoch, nur nicht mehr, wenn ich die Pfadangabe "variabel" gestalten will.
Es gab hierzu schon folgenden Lösungsansatz
Dim str7Zip As String
str7Zip = ThisWorkbook.Path & "\7ZipPortable\App\7Zip\7z.exe"
Hat aber nicht funktioniert, es kam der Fehler Datei nicht zu finden. Ebenso hilft es nicht wie im Original Code mit den drei " zu arbeiten. Wenn ich bei Originalcode eines dieser drei " entferne kommt es ebenfalls zum Fehler. Kurz noch zur Erklärung warum ich dies benötige
Ich möchte einen Ordner mit mehreren Dateien an andere Personen übergeben. Die darin enthaltene Excel Datei wird von den Nutzern aufgerufen und soll "autark" funktionieren, d.h. keine Installation von 7Zip notwendig, da es sich um die portable Version handelt. Die Dateien werden in der vorgefertigten Ordnerstruktur abgelegt. Sonst müsste jeder in dem VBA Code rumbasteln.
Hauptordner - enthält Excel Datei und drei Unterordner
Unterordner 1 - enthält PDF Dateien welche gezippt werden sollen
Unterordner 2 - enthält 7-Zip portable, keine Installation des User notwendig
Unterordner 3 - dort sollen die gezippten Files gespeichert werden
Der ganze Code von mir funktioniert bereits. Allerdings verweist im Code die Aktion für Unterordner 2 Ordner meines PC. Wenn ich nun den Gesamten Ordner an andere Personen gebe, dann müsste man dort im VBA Code die Pfade anpassen, so dass alles funktioniert. Da ich aber ja in einem Ordner übergebe, ist meine Überlegung auf den Speicherort der Excel Datei (Hauptordner) Bezug zu nehmen und damit dann eine fixe und korrekte Pfadangabe für die Aktion im Code (Unterordner 2) zu haben.
Ich bin absoluter Laie hinsichtlich VBA, bei evtl. Antworten bitte beachten - also Erklärung für DAU gesucht
Und hier nochmal mein aktueller Code in Gänze
Sub CommandButton2_Click()
Dim c As Range, strDat As String, strZip As Variant, strQuelle As Variant
Dim strListe As String, FF As Integer, sh, strMsg As String
Range("A101:A107").Select
Selection.Copy
Range("A110").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWindow.SmallScroll Down:=-84
Set sh = CreateObject("WScript.Shell")
'Verzeichnisse / Parameter (Switches)
strQuelle = Application.ActiveWorkbook.Path & "\Bedingungen SVFP 2017\" 'Backslash nicht vergessen!
Const str7Zip As String = """C:\Users\Marco\Desktop\Rahmenvertrag Tool\7ZipPortable\App\7Zip\7z.exe""" 'Anpassen!
Const strParam As String = " -r -mx=5 -mmt=on" 'Unterverzeichnisse, normale Kompression, Mehrkernproz.
'Name der Zip-Datei:
strZip = Application.GetSaveAsFilename(ThisWorkbook.Path & "\Bedingungen Zip Test\" & Range("D4") & "_" & Format(Now, "yyyymmdd_hh-mm") & " Bedingungen SVFP.zip", "*.zip,*.zip")
If strZip = False Then Exit Sub
strZip = Chr(34) & strZip & Chr(34)
'Datei-Liste temporär anlegen
strListe = Mid(strZip, 2, InStrRev(strZip, "\") - 1) & Format(Now, "yyyy-mm-dd_hh-mm-ss")
FF = FreeFile()
Open strListe For Output As #FF
'Schleife über alle selektierten Zellen:
For Each c In Selection
'Dateiname
strDat = strQuelle & c.Value
'Existiert die Datei
If Dir(strDat, vbDirectory) <> "" Then
'in Liste schreiben
Print #FF, strDat
Else
strMsg = strMsg & vbLf & strDat
End If
Next
Close #FF
'Zippen
'Debug.Print str7Zip & " a -tzip " & strZip & " @" & Chr(34) & strListe & Chr(34) & strParam
sh.Run str7Zip & " a -tzip " & strZip & " @" & Chr(34) & strListe & Chr(34) & strParam, , True
Set sh = Nothing
'Liste löschen
Kill strListe
'Wurden manche Dateien nicht gefunden?
If Len(strMsg) > 0 Then
MsgBox "Es konnten folgende Dateien nicht gefunden werden:" & vbLf & strMsg
End If
End Sub
Bin für jede Hilfe Dankbar!!
|