das unten stehende
Sub funktioniert soweit ganz gut aber wenn ich die selbe Datei mit Änderungen in einen anderen _
_
Ordner speichern möchte klappt das irgendwie nicht so ganz.
Könnt ihr mir bitte mal wieder dabei helfen ?
pfad ist die original Datei und pfad2 die Änderungen
Sub pdf()
Dim pfad As String
Dim pfad2 As String
Dim name As String
Dim jahr As Integer
Dim strPath As String
Dim Fso, datei, datei2
strPath = pfad & name
name = "KW " & ThisWorkbook.Worksheets("Namen").Range("M2")
jahr = Year(CDate(ThisWorkbook.Worksheets(2).Range("L2")))
pfad = ThisWorkbook.Path & "\" & "Fahrpläne" & "\" & jahr & "\" & "MO - FR" & "\" & name & "\" & _
_
pfad2 = ThisWorkbook.Path & "\" & "Fahrpläne" & "\" & jahr & "\" & "MO - FR" & "\" & name & "\" _
_
& "Änderungen am " & "\" & Date & "\"
Set fs = CreateObject("Scripting.FileSystemObject")
Set Fso = CreateObject("Scripting.FileSystemObject")
datei = pfad & name
datei2 = pfad2 & name
If fs.folderexists(pfad) Then
GoTo export
Else
Call MakeDir(pfad)
GoTo export
End If
export:
With Sheets("Plan")
With .PageSetup
.PrintArea = "Druckbereich"
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = "&""arial,standard""&8" & "erstellt am: " & Date & " um " & Format(Time, " _
_
HH:MM") & _
" Uhr" & " von: " & Application.UserName
.CenterFooter = ""
.RightFooter = ""
End With
End With
If fs.folderexists(datei) Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
datei2, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
Else
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
datei, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
End If
End Sub
ich Danke euch schon mal im Voraus für eure Hilfe
Gruß Stefan