Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1604to1608
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Änderungen der Datei seperat speichern

Änderungen der Datei seperat speichern
28.01.2018 07:26:30
Stefan
Hallo liebe Gemeinde,
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

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Änderungen der Datei seperat speichern
28.01.2018 07:34:41
Stefan
PS: sorry für den Doppelpost, war keine Absicht
AW: Änderungen der Datei seperat speichern
28.01.2018 10:35:48
Herbert
Hallo Stefan,
WAS klappt denn nicht so ganz?
Servus
AW: Änderungen der Datei seperat speichern
28.01.2018 11:19:34
Stefan
damit die selbe Datei falls in pfad schon vorhanden in pfad2 nochmal gespeichert werden soll
AW: Änderungen der Datei seperat speichern
28.01.2018 11:21:36
Stefan
ich habe es jetzt schon auch so probiert:
If Len(Dir(datei)) > 0 Then
Call MakeDir(pfad2)
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
datei2, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
Else
Call MakeDir(pfad)
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
datei, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
End If
Anzeige
AW: Änderungen der Datei seperat speichern
28.01.2018 12:36:26
Herbert
Hallo Stefan,
es tut mir leid, aber in dem Code ist mir zu viel Tohuwabohu. Das dauert mir zu lange. Vielleicht findet sich ja noch jemand, der das machen kann. Ich drücke Dir die Daumen.
Servus
AW: Änderungen der Datei seperat speichern
29.01.2018 16:24:54
ChrisL
Hi Stefan
Der Ordner muss bis und mit "...\MO - FR\" schon vorhanden sein. Ordner KW und folgende wird dann automatisch erstellt.
Sub pdf()
Dim strName As String
Dim strPfad As String
Dim intJahr As Integer
Dim objFSO As Object
strName = "KW " & ThisWorkbook.Worksheets("Namen").Range("M2")
intJahr = Year(CDate(ThisWorkbook.Worksheets(2).Range("L2")))
strPfad = ThisWorkbook.Path & "\Fahrpläne\" & intJahr & "\MO - FR\" & strName & "\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FolderExists(strPfad) Then Call MkDir(strPfad)
If objFSO.FileExists(strPfad & strName & ".pdf") Then
strPfad = strPfad & "\Aenderung am " & Date & "\"
If Not objFSO.FolderExists(strPfad) Then Call MkDir(strPfad)
End If
'hier formatieren
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
strPfad & strName & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End Sub
cu
Chris
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige