Anzeige
Archiv - Navigation
1740to1744
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zwischenspeicherung einer Datei

Zwischenspeicherung einer Datei
18.02.2020 13:45:30
STeve
Haalllllloooo liebe Helfer.........habe einen Zwischenspeicherbutton in einer Datei.
Siehe ua. Code von Sepp v. 11.1.19.
Es wird die akt. Datei mit ..............z.B.:..Dateiname.xlsm.......im gleichen Ordner unter:
..Dateiname_1.xlsm........
...Dateiname_2.xlsm...
...Dateiname_3.xlsm...
fortlaufend aufsteigend abgespeichert..........
Wenn aber einer User/Bearbeiter der Datei aber z.B. die Zwischenspeicherung ....... _1 rauslöscht - - dann wird wieder unter _1 die letzte Version abgespeichert................dies soll aber nicht geschehen sondern die Nummerierung soll nur nach oben ausgeführt werden.
z.B.: folgende Sicherungen sind vorhanden:
...Dateiname_2.xlsm...
...Dateiname_3.xlsm...
..Dateiname_4.xlsm........
...Dateiname_5.xlsm...
...Dateiname_6.xlsm...
Es fehlt also die Nr. _1............dann soll die _7 als nächste Speicherung angelegt werden.
Hoffe ihr könnt mir helfen.
Besten Dank und mfg
STeve
Sub Zwischenspeichern() ''progr. von Sepp am 11.1.19 auf Herber
Dim strPath As String
Dim strFile As String
Dim strExt As String
Dim strNewFile As String
Dim varFile As Variant
strPath = ThisWorkbook.Path
varFile = Split(Split(ThisWorkbook.Name, ".")(0), "_")
strExt = Split(ThisWorkbook.Name, ".")(1)
If IsNumeric(varFile(UBound(varFile))) Then ReDim Preserve varFile(UBound(varFile) - 1)
strFile = strFile & Join(varFile, "_") & "($)." & strExt
strNewFile = NextFileIndexName(strPath, strFile, "_0", 1)
If Len(strNewFile) Then
' MsgBox "Die Datei '" & strNewFile & "' wird neu angelegt!"
ActiveWorkbook.SaveAs Filename:=strNewFile
Else
MsgBox "Eine Zwischenspeicherung der akt. Datei konnte leider nicht durchgeführt werden."
End If
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

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

Betreff
Datum
Anwender
Anzeige
AW: Zwischenspeicherung einer Datei
23.02.2020 12:36:20
fcs
Hallo Steve,
ich hab die Function mal so angepasst, dass immer die höchste vorhande Copy-Nummer ermittelt wird und dann um 1 erhöht wird. Lücken in den Nummern werden übersprungen.
Hinweis: das Sonderzeichen(Trennzeichen) vor der Hochzähl-Nummer darf nur 1 Zeichen lang sein, es darf kein Punkt sein! Ich hab aber keine entsprechenden Prüfungen eingebaut.
LG
Franz
Textdatei mit Modifikation - geändert ist nur die Function.
https://www.herber.de/bbs/user/135383.txt
Danke Franz - perfekt
23.02.2020 12:59:04
STeve
Hallo lieber Fcs......Wouuuuwwwwww...Danke - genau so wie ich es brauche. Perfekt.
Wünsche dir noch einen schönen Sonntag Franz.
glg STeve
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige