Microsoft Excel

Herbers Excel/VBA-Archiv

Änderungen der Datei seperat speichern


Betrifft: Änderungen der Datei seperat speichern von: Stefan
Geschrieben am: 28.01.2018 07:26:30

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

  

Betrifft: AW: Änderungen der Datei seperat speichern von: Stefan
Geschrieben am: 28.01.2018 07:34:41

PS: sorry für den Doppelpost, war keine Absicht


  

Betrifft: AW: Änderungen der Datei seperat speichern von: Herbert Grom
Geschrieben am: 28.01.2018 10:35:48

Hallo Stefan,

WAS klappt denn nicht so ganz?

Servus


  

Betrifft: AW: Änderungen der Datei seperat speichern von: Stefan
Geschrieben am: 28.01.2018 11:19:34

damit die selbe Datei falls in pfad schon vorhanden in pfad2 nochmal gespeichert werden soll


  

Betrifft: AW: Änderungen der Datei seperat speichern von: Stefan
Geschrieben am: 28.01.2018 11:21:36

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


  

Betrifft: AW: Änderungen der Datei seperat speichern von: Herbert Grom
Geschrieben am: 28.01.2018 12:36:26

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


  

Betrifft: AW: Änderungen der Datei seperat speichern von: ChrisL
Geschrieben am: 29.01.2018 16:24:54

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


Beiträge aus dem Excel-Forum zum Thema "Änderungen der Datei seperat speichern"