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!!