19.12.2020, 03:31
ich habe ein Problem,
im Ordner (Laufwerk) & "" & ("\DE\Bremen\Garden\Front Office\Rechnungen\offen Firmen\")
Laufwerk = (Tabelle1.Range("A2").Value)
stehen zwei Dateien Rechnung01.pdf und
Kostenübernahme.pdf
diese können über eine Listbox auf dem Tabellenblatt1 ausgewählt werden
in Zeile C25 wird die Rechnung01 ausgewiesen
in Zelle C26 wird die Kostenübernahme ausgewiesen
in Zeile C27 soll steht der neue Name für die zusammengefügten Dateien
Ich kann leider ausschliesslich den pdf24 Creator verwenden.
Ich habe in den verschiedenen Foren einen Code gefunden und versucht in nach meinen Bedürfnissen anzupassen - leider klapp das nicht so richtig.
Code:
Private Sub CommandButton1_Click()
Dim fso As Object
Dim WshShell As Object
Dim strOrdner As String
Dim i As Long
Dim strMulti As String
Dim strCommand As String
Dim strGS As String
Dim strPfad1 As String
Dim strPfad2 As String
Dim strPfad3 As String
Dim Laufwerk As String
Laufwerk = (Tabelle1.Range("A2").Value)
strPfad1 = (Laufwerk) & "" & ("\DE\Bremen\Garden\Front Office\Rechnungen\offen Firmen\") & "" & (Tabelle1.Range("C25").Value)
strPfad2 = (Laufwerk) & "" & ("\DE\Bremen\Garden\Front Office\Rechnungen\offen Firmen\") & "" & (Tabelle1.Range("C26").Value)
strPfad3 = (Laufwerk) & "" & ("\DE\Bremen\Garden\Front Office\Rechnungen\offen Firmen\") & "" & (Tabelle1.Range("C27").Value)
Set fso = CreateObject("Scripting.FileSystemObject")
'Pfad zu pdf24.exe anpassen
strGS = "C:\Program Files (x86)\PDF24\pdf24-Creator.exe"
'Ausgabeordner anpassen
strOrdner = (Laufwerk) & "" & "\DE\Bremen\Garden\Front Office\Rechnungen\offen Firmen\"
With Tabelle1 'anpassen
'Spalte A : Dateinamen mit komplettem Pfad
'Spalte B : Dateinamen mit komplettem Pfad
For i = 1 To .UsedRange.Rows.Count
If fso.FileExists(.Cells(i, 1).Value) And fso.FileExists(.Cells(i, 2).Value) Then
strMulti = " " & .Cells(i, 1).Value & " " & .Cells(i, 2).Value
strOrdner = fso.GetFolder(strOrdner).ShortPath
strGS = fso.GetFile(strGS).ShortPath
strCommand = strGS & " -q -dSAFER -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile="
strCommand = strCommand & strOrdner & "\"
'Name der Ausgabedatei = Name der Datei in der Spalte A
strCommand = strCommand & fso.GetFile(.Cells(i, 2).Value).Name & strMulti
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run strCommand, 0, True
Set WshShell = Nothing
End If
Next
End With
Set fso = Nothing
MsgBox "Fertig"
End Sub
Mit dem rot markierten Teil komme ich leider nicht klar.
Ich brauche auch keine Schleifenfunktion.
Die Dateien aus Zelle C25 und C26 sollen als eine pdf.Datei zusammengefasst werden und dann unter dem Namen in C27 in dem Ordner
(Laufwerk) & "" & ("\DE\Bremen\Garden\Front Office\Rechnungen\offen Firmen\")
abgespeichert und wenn möglich die 2 ursprünglichen Dateien auch dem selben Verzeichnis (aus Zelle C25 und C26) auch gleich gelöscht werden.
Wäre toll wenn mir jemand weiterhelfen könnte.
Gruß Frank
im Ordner (Laufwerk) & "" & ("\DE\Bremen\Garden\Front Office\Rechnungen\offen Firmen\")
Laufwerk = (Tabelle1.Range("A2").Value)
stehen zwei Dateien Rechnung01.pdf und
Kostenübernahme.pdf
diese können über eine Listbox auf dem Tabellenblatt1 ausgewählt werden
in Zeile C25 wird die Rechnung01 ausgewiesen
in Zelle C26 wird die Kostenübernahme ausgewiesen
in Zeile C27 soll steht der neue Name für die zusammengefügten Dateien
Ich kann leider ausschliesslich den pdf24 Creator verwenden.
Ich habe in den verschiedenen Foren einen Code gefunden und versucht in nach meinen Bedürfnissen anzupassen - leider klapp das nicht so richtig.
Code:
Private Sub CommandButton1_Click()
Dim fso As Object
Dim WshShell As Object
Dim strOrdner As String
Dim i As Long
Dim strMulti As String
Dim strCommand As String
Dim strGS As String
Dim strPfad1 As String
Dim strPfad2 As String
Dim strPfad3 As String
Dim Laufwerk As String
Laufwerk = (Tabelle1.Range("A2").Value)
strPfad1 = (Laufwerk) & "" & ("\DE\Bremen\Garden\Front Office\Rechnungen\offen Firmen\") & "" & (Tabelle1.Range("C25").Value)
strPfad2 = (Laufwerk) & "" & ("\DE\Bremen\Garden\Front Office\Rechnungen\offen Firmen\") & "" & (Tabelle1.Range("C26").Value)
strPfad3 = (Laufwerk) & "" & ("\DE\Bremen\Garden\Front Office\Rechnungen\offen Firmen\") & "" & (Tabelle1.Range("C27").Value)
Set fso = CreateObject("Scripting.FileSystemObject")
'Pfad zu pdf24.exe anpassen
strGS = "C:\Program Files (x86)\PDF24\pdf24-Creator.exe"
'Ausgabeordner anpassen
strOrdner = (Laufwerk) & "" & "\DE\Bremen\Garden\Front Office\Rechnungen\offen Firmen\"
With Tabelle1 'anpassen
'Spalte A : Dateinamen mit komplettem Pfad
'Spalte B : Dateinamen mit komplettem Pfad
For i = 1 To .UsedRange.Rows.Count
If fso.FileExists(.Cells(i, 1).Value) And fso.FileExists(.Cells(i, 2).Value) Then
strMulti = " " & .Cells(i, 1).Value & " " & .Cells(i, 2).Value
strOrdner = fso.GetFolder(strOrdner).ShortPath
strGS = fso.GetFile(strGS).ShortPath
strCommand = strGS & " -q -dSAFER -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile="
strCommand = strCommand & strOrdner & "\"
'Name der Ausgabedatei = Name der Datei in der Spalte A
strCommand = strCommand & fso.GetFile(.Cells(i, 2).Value).Name & strMulti
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run strCommand, 0, True
Set WshShell = Nothing
End If
Next
End With
Set fso = Nothing
MsgBox "Fertig"
End Sub
Mit dem rot markierten Teil komme ich leider nicht klar.
Ich brauche auch keine Schleifenfunktion.
Die Dateien aus Zelle C25 und C26 sollen als eine pdf.Datei zusammengefasst werden und dann unter dem Namen in C27 in dem Ordner
(Laufwerk) & "" & ("\DE\Bremen\Garden\Front Office\Rechnungen\offen Firmen\")
abgespeichert und wenn möglich die 2 ursprünglichen Dateien auch dem selben Verzeichnis (aus Zelle C25 und C26) auch gleich gelöscht werden.
Wäre toll wenn mir jemand weiterhelfen könnte.
Gruß Frank