Sub
PDF_ablegen()
On
Error
GoTo
Fehler
Const
APPNAME =
"PDF_ablegen"
Dim
TB1
As
Worksheet, i
As
Integer
Dim
ZE
As
Integer
, LR
As
Integer
Dim
Pfad
As
String
, Datei
As
String
, Ext
As
String
, NewName
As
String
Set
TB1 = Sheets(
"Tabelle1"
)
ZE = 7
With
TB1
Pfad = .Range(
"B1"
) & IIf(Right(.Range(
"B1"
), 1) =
"\", "
", "
\")
Datei = <strong>.Range(
"B3"
)</strong>
Ext =
".pdf"
LR = .Cells(.Rows.Count,
"A"
).
End
(xlUp).Row
If
Dir(Pfad & Datei & Ext) <>
""
Then
For
i = ZE
To
LR
FileCopy Pfad & Datei & Ext, Pfad & .Cells(i, 1) &
"_"
& .Cells(i, 2) & Ext
Next
Else
MsgBox
"PDF / Verzeichnis nicht vorhanden"
End
If
End
With
Err.Clear
Fehler:
If
Err.Number <> 0
Then
MsgBox
"Fehler in Sub "
""
& APPNAME &
""
""
& vbCrLf _
&
"Fehlernummer: "
& Err.Number & vbLf & Err.Description: Err.Clear
End
Sub