Liebe Leute,
aus einer Masterdatei erzeuge ich Dateien mit den Namen Malte, Lola usw.
Manchmal ist es aber so, dass ich einen Fehler gemacht habe, und dass ich
die bereits gespeicherte Datei nicht überschreiben möchte,
sondern den Dateinamen VOR .xls um ein zusätzliches Zeichen verlängern möchte, also Lola.xls, Lola..xls, Lola...xls
.
Wie muss ich den folgenden Code, der nicht von mir stammt, ändern,
damit das klappt?
Sub Abspeichern_neuer_Name()
Dim dName$
Dim DatName As String
DatName = ActiveWorkbook.Worksheets(1).Range("F20") ' in F20 steht Malte oder Lola... oder...
dName = ThisWorkbook.Path & "\Versuche\" & Range("F20") & ".xls
ActiveSheet.Copy
ActiveWorkbook.SaveAs dName
ActiveWorkbook.Close Savechanges:=False
ActiveWorkbook.Save
Application.Quit ' schließt Datei komplett
End Sub
Vielen Dank für Hilfe!
Ciao Schwipp
Nachtrag:
Hallo,
Sub Abspeichern_neuer_Name()
Dim strN As String
Dim strP As String
Dim strZ As String
strN = ActiveWorkbook.Worksheets(1).Range("F20") ' in F20 steht Malte oder Lola... oder...
strP = ThisWorkbook.Path & "\Versuche\" '& Range("F20") & ".xls"
strZ = "."
Do
If Dir(strP & strN & strZ & "xls") = "" Then
Exit Do
Else
strZ = strZ & strZ
End If
Loop
ActiveSheet.Copy
ActiveWorkbook.SaveAs strP & strN & strZ & "xls"
ActiveWorkbook.Close Savechanges:=False
ActiveWorkbook.Save
Application.Quit ' schließt Datei komplett
End Sub
Gruß Uwe
Uwe, herzlichen Dank, ich will das gleich mal testen!
Hallo,
mein vorheriger Code war Mist. Hier jetzt richtig und eine weitere Variante entsprechend Deinem Betreff mit Zähler in Klammern:
Option Explicit
Sub Abspeichern_neuer_Name_Punkte()
Dim strN As String
Dim strP As String
Dim strZ As String
strN = ActiveWorkbook.Worksheets(1).Range("F20") ' in F20 steht Malte oder Lola... oder...
strP = ThisWorkbook.Path & "\Versuche\"
strZ = "."
Do
If Dir(strP & strN & strZ & "xls") = "" Then
Exit Do
Else
strZ = String(Len(strZ) + 1, strZ)
End If
Loop
ActiveSheet.Copy
ActiveWorkbook.SaveAs strP & strN & strZ & "xls"
ActiveWorkbook.Close Savechanges:=False
ActiveWorkbook.Save
Application.Quit ' schließt Datei komplett
End Sub
Sub Abspeichern_neuer_Name_Zaehler()
Dim strN As String
Dim strP As String
Dim lngZ As Long
strN = ActiveWorkbook.Worksheets(1).Range("F20") ' in F20 steht Malte oder Lola... oder...
strP = ThisWorkbook.Path & "\Versuche\"
lngZ = 1
Do
If Dir(strP & strN & "(" & lngZ & ").xls") = "" Then
Exit Do
Else
lngZ = lngZ + 1
End If
Loop
ActiveSheet.Copy
ActiveWorkbook.SaveAs strP & strN & "(" & lngZ & ").xls"
ActiveWorkbook.Close Savechanges:=False
ActiveWorkbook.Save
Application.Quit ' schließt Datei komplett
End Sub
Code eingefügt mit: Excel Code Jeanie
Gruß Uwe
Hallo Uwe,
Im Archiv bei "Herber" habe ich sowas ähnliches gefunden, die Kombination Deines Codes mit dem des Archivs war aber noch nicht erfolgreich...
Hinsichtlich der Abfragen und der Messagebox-Anzeigen funktioniert das dem Archiv ,
und lautet für mich angepasst:
Sub TestText()
Dim TB As Worksheet
Dim dName$
Set TB = ActiveWorkbook.Worksheets(5) ' was bedeutet die 5?
dName = "F:\Versuche\ " & Range("F20") & ".xls"
If Dir$(dName, vbNormal) <> "" Then
MsgBox "'Datei ist vorhanden; "
Else
MsgBox "'Datei ist nicht vorhanden"
End If
End Sub
Vielen herzlichen Dank für Deine Mühe,
ciao Schwipp
Also ich probier jetzt erstmal Deine elegante Variante mit Zähler in Klammern!!! (reimt sich ja sogar!)
Uwe, genial, Klammerversion klappt perfekt auf Anhieb, 1000 Dank !