Speichern - weitere anlegen nicht überschreiben

Hi
Folgende Frage heute...
Ich speichere mit VBA eine Datei in einem bestimmtem Ordner:

Dim siname As String
siname = "Datei_" & Date & ".xlsm"
ThisWorkbook.Save
ThisWorkbook.SaveAs "C:\Dokumente\" & siname

Dabei lege ich eine "Sicherungskopie" in einem anderem Ordner an.
Wenn diese "Sicherungskopie" jetzt bereits angelegt ist, dann gibt es die Abfrage, ob es ersetzt werden soll.
Das soll es nicht.
Wenn diese "Sicherung" bereits vorhanden ist, dann soll er eine Datei mit dem gleichen Namen anlegen, aber eine Zählung anhängen - also eine _2.
Ist das machbar und ist das viel Aufwand?
Wäre es vielleicht auch möglich, von Anfang an einen Counter anzuhängen?
Also schon bei der ersten "Sicherung" ein "_1" anzuhängen und das dann immer weiter zu führen für jede weitere Speicherung an diesem Tag?
Oder ist das vom Aufwand her einfach zu umfangreich?
Danke für eure Hilfe :-)
Daniel

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Daniel,
so?
Modul Modul1

Option Explicit 
 
Sub saveCopy() 
Dim strFileName As String 
 
strFileName = NextFileIndexName("C:\Dokumente\", "Datei_" & Format(Date, "yyyymmdd") & "_($).xlsm", "00", 1) 
ThisWorkbook.Save 
If Len(strFileName) Then ThisWorkbook.SaveAs strFileName 
End Sub 
 
Private Function NextFileIndexName(ByVal FilePath As String, ByVal FileNamePattern As String, Optional ByVal IndexFormat As _
  String = "-0", Optional ByVal StartIndex As Long = 0, Optional ByVal ShowNullIndex As Boolean = True) As String 
  'PARAMETERINFO: 
  'FilePath         = Directory where the file is or should be located. 
  'FileNamePattern  = Filename where '($)' marks the position of index-number! 
  'IndexFormat      = The desired Format of the indexnumber. 
  'StartIndex       = Lower bound of the indexnumber. 
  'ShowNullIndex    = If true, the index '0' will be shown in the filename. 
   
  Dim varFile As Variant, strCheck As String, strIndex As String, strTemp As String, lngIndex As Long 
   
  Const PLACEHOLDER As String = "($)" 
   
  On Error GoTo ErrorHandler 
 
  If InStr(1, FileNamePattern, PLACEHOLDER) = 0 Then GoTo ErrorHandler 
  If Len(FileNamePattern) <> Len(Replace(FileNamePattern, PLACEHOLDER, "")) + Len(PLACEHOLDER) Then GoTo ErrorHandler 
  If Dir(FilePath, vbDirectory) = "" Then GoTo ErrorHandler 
  If Right(FilePath, 1) <> "\" Then FilePath = FilePath & "\" 
   
  varFile = Split(FileNamePattern, PLACEHOLDER) 
 
  lngIndex = StartIndex 
 
  Do 
    If lngIndex = 0 And ShowNullIndex Then 
      strIndex = Format(lngIndex, IndexFormat) 
    ElseIf lngIndex > 0 Then 
      strIndex = Format(lngIndex, IndexFormat) 
    End If 
    lngIndex = lngIndex + 1 
    strTemp = FilePath & varFile(0) & strIndex & varFile(1) 
    strCheck = Dir(strTemp, vbNormal) 
  Loop Until strCheck = "" 
 
  NextFileIndexName = strTemp 
  Exit Function 
ErrorHandler: 
  NextFileIndexName = "" 
End Function 
 
 

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

Beliebteste Forumthreads (12 Monate)

Speichern - weitere anlegen nicht überschreiben

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Speichern - weitere anlegen nicht überschreiben

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread