AW: Speichern - weitere anlegen nicht überschreiben
01.05.2019 11:34:43
Sepp
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