Speichern VBA Filname anpassen

Hallo,
ich habe da ein paar Probleme mit dem Speichen von Dateien.
Ich hoffe mir kann hier jemand helfen.
Wie kann ich die "2006" im Filename durch die aktuelle Jahreszahl ersetzen.
Das speichern soll auch die nächsten Jahre (2007...usw) noch funktionieren.
'----------------------SPEICHERN----------------------------
Dim DateiName As String, Pfad_Kopie As String, Pfad As String, DateiNameKopie As String
DateiName = ActiveWorkbook.Name
Pfad = ActiveWorkbook.Path
ActiveWorkbook.SaveAs Filename:=Pfad & "\2006" & "\" & "Monatsabschluss " & DateiName,
FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
'-------------------------------------------------------------------
Nächste Problem:
Wie setze ich den Pfad ein Verzeichnis zurück. Also zb. nicht c:\monat\2006\ sondern c:\monat\ (dies ist nur ein Beispiel). Die Verzeichnisse ändern sich ständig und ich muss ein Verzeichnis zurück.
Im Filename muss der Monat der im "Monatsabschluss" Zelle C1 steht als Zahl eingefügt werden (hier cb1). Wie kann ich die Ausgabe zweistellig machen. Ich habe hier eine " 0" vorgestellt, aber bei Monat 11 u. 12 siehts dann so aus 011 u.012.
Und auch hier das Problem mit der Jahreszahl am Ende des Filname. Hier soll die Jahreszahl aber nur 2 stellig stehen (".06.xls"). Also hier soll auch die aktuelle Jahreszahl eingefügt werden damit es nächstes Jahr auch noch klappt.
'----------------------SPEICHERN----------------------------
Dim DateiName As String, Pfad_Kopie As String, Pfad As String, DateiName2 As String,
DateiName1 As String
DateiName = ActiveWorkbook.Name
DateiName1 = Right(DateiName, Len(DateiName) - 16)
DateiName2 = Left(DateiName1, Len(DateiName1) - 10)
Pfad = ActiveWorkbook.Path
cb = Worksheets("Monatsabschluss").Cells(1, 3)
cb1 = Month(cb)
ActiveWorkbook.SaveAs Filename:=Pfad & "\" & DateiName2 & " 0" & cb1 & ".06.xls",
FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
Kill Pfad & "\" & DateiName1
'-------------------------------------------------------------------
Danke schon einmal für Eure hilfe.
iris

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo
probier mal
Option Explicit

Sub Demo()
    Dim DateiName As String, Pfad_Kopie As String, Pfad As String, DateiName2 As String
    Dim NewPath As String, DateiName1 As String, cb As Variant, cb1 As Variant
    DateiName = ActiveWorkbook.Name
    DateiName1 = Right(DateiName, Len(DateiName) - 16)
    Debug.Print DateiName1
    DateiName2 = Left(DateiName1, Len(DateiName1) - 10)
    Debug.Print DateiName2
    Pfad = ActiveWorkbook.Path
    Debug.Print Pfad
    ChDir ".."
    NewPath = CurDir
    Debug.Print NewPath
    ChDir (Pfad)
    cb = Worksheets("Monatsabschluss").Cells(1, 3)
    cb1 = Month(cb)
    ActiveWorkbook.SaveAs Filename:=NewPath & "\" & DateiName2 & " 0" & cb1 & "." & _
        Format(DateSerial(Year(Now), 1, 1)) & ".xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    Kill Pfad & "\" & DateiName1
End Sub

Gruss Rainer

Pfad = ActiveWorkbook.Path 'Pfad eine Ebene höher ermitteln Pfad2 = Pfad Do Until Right(Pfad2, 1) = "\" Pfad2 = Left(Pfad2, Len(Pfad2) - 1) 'letztes Zeichen abschneiden Loop Pfad2 = Left(Pfad2, Len(Pfad2) - 1) 'Backslash abschneiden 'Verzeichnis wechseln ChDir Pfad2 ActiveWorkbook.SaveAs Filename:=Pfad2 & "\" & DateiName2 & Format(cb1, "00") & "." & Format(Now, "YY")) & ".xls", _ FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False Statt direkt zu speichern mit "SaveAs" könnte man auch den 'Speichern unter' Dialog anzeigen' Dann besteht die Möglichkeit den Pfad ggf. manuell noch anzupassen. Application.Dialogs(xlDialogSaveAs).Show (DateiName2 & Format(cb1, "00") & "." & Format(Now, "YY"))

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread