Um das Überschreiben abzufangen würde ich an Stelle der Codezeile in der gespeichert wird (bei dir ActiveDocument.SaveAs Pfad & Datei ) folgendes einfügen (vorher noch die Variablen index deklarieren)
Dim index As Integer
If Dir(Pfad & Datei) = "" Then
'Datei gibt es noch nicht also speichern
ActiveDocument.SaveAs Pfad & Datei
Else
' Datei gibt es schon, also einen Index anhängen
index = 2 'da die Original Datei keinen index hat, beginnt die erste Kopie mit der 2
Datei = Left(Datei, Len(Datei) - 4) & index & ".doc" 'die letzten 4 Zeichen ersetzen durch 2.doc
While Dir(Pfad & Datei) <> "" 'prüfen ob Datei existiert, wenn ja gehts bei wend weiter sonst in die while schleife
index = index + 1 ' INdex erhöhen
If index > 10 Then
Datei = Left(Datei, Len(Datei) - 6) & index & ".doc" ' jetzt die letzten 6 zeichen weg da index jetz zweistellig, da ja schon mindestens die zwei da ist
Else
Datei = Left(Datei, Len(Datei) - 5) & index & ".doc" ' jetzt die letzten 5 zeichen weg, da ja schon mindestens die zwei da ist
End If
Wend
' jetzt haben wir einen index den es noch nicht gab also speichern
ActiveDocument.SaveAs Pfad & Datei
End If
Das prüft jetzt ob der Dateiname existiert und sucht sich dann den nächstfolgenden index und hängt ihn an. Geht bis zu einem index von 100. Sollte ein INdex > 100 erforderlich sein, müßte man anpassen.
Anschließend wird auch gespeichert.
Gruß
|