|
Hallo liebe Forenmitglieder,
ich habe von Excel Makros / VBA null, gar keine Ahnung. Mit Hilfe von diversen Forenbeiträgen habe ich einen Teil dessen was ich umsetzen möchte schon per "drag & drop" lösen können.
Wie gesagt null, gar keine Ahnung. Nun bin ich an einem Punkt wo ich nicht mehr weiter weiß. Ich habe schon diverse Dinge versucht aber mangels knowhow habe ich jetzt die Waffen gestreckt.
Kurz zu meinem Thema
Ich möchte anhand von einer Excel Tabelle markierte "PDF Dateinamen" in 7-Zip zusammenfassen. Dies funktioniert auch Dank diverser Forenbeiträge. Mein Problem ist, dass ich nicht auf einen statischen Ordner auf meinem PC verweisen möchte. Ziel ist es den Pfad variabel zu halten, d.h. ich überlasse Kollegen einen Ordner in dem sich alle benötigen Dateien befinden. Den Ordner können die Kollegen dorthin speichern wo sie wollen. In dem Ordner befindet sich eine Excel Datei, die quasi den Mittelpunkt darstellt. Dort werden Berechnungen etc. vorgenommen. Beim klicken auf einen Knopf werden dann definierte und markierte PDF Dateien in einem Ordner gesucht und zusammengeführt via 7-Zip. Diese Zip Datei soll dann wieder in einem definierten Ordner abgelegt werden.
Ich kopiere hier mal meinen Code rein. Die Bereiche mit dem roten x ?, müssten vom Pfad geändert werden. Der Pfad soll als "Grundstock" der Pfad der Excel Datei sein und dann noch in Unterordner weiterführen.
Keine Ahnung ob Ihr mit meinem Text eine Ahnung habt was ich hier meine. Ich hoffe aber drauf. Für Profis wie es hier die meisten sind, ist das Problem wahrscheinlich lächerlich. Aber wie gesagt, null Ahnung...
Danke für Eure Hilfe
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:A117").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\7-ZipPortable\App\7-Zip\7z.exe""" 'Anpassen!
Const strParam As String = " -r -mx=5 -mmt=on" 'Unterverzeichnisse, normale Kompression, Mehrkernproz.
'Name der Zip-Datei:
strZip = Application.GetSaveAsFilename("C:\Users\Marco\Desktop\Rahmenvertrag Tool\Bedingungen Zip Test\Test.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 |