Anzeige
Archiv - Navigation
1664to1668
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

Mappe (mit Index) fortlaufend speichern

Mappe (mit Index) fortlaufend speichern
11.01.2019 18:02:28
STeve
Guten Abend ;-)..ich schon wieder mit einer Bitte:
Eine Mappe mit .xlsm soll (aktiv vom User per cmd) gespeichert werden.
Ordner und Name mir unbekannt.
Gleicher Ordner und gleicher Name (wenn dieser schon vorhanden dann aufwärts nummeriert(als Name (1)......(2)....(3).....usw.)
Active Mappe speichern und schließen
Neue Mappe = Active Mappe(mit Index) öffnen
Sub speichern()
Dim pfad As String
Dim Name As String
Dim Alles As String
pfad = ThisWorkbook.Path
Name = ThisWorkbook.Name   'hier ist aber schon .xlsm -deshalb Index danach- 'enthalten
Alles = pfad & "\" & Name
Dim i As Integer
For i = 1 To 5   '' mal so bis 5 angegeben
If Dir(Alles & i) = "" Then
MsgBox "Die" & Alles & i & "wird neu angelegt!"
ActiveWorkbook.SaveAs Filename:=Alles & i  'der Index wird ? hinter .xlsm angefügt
End If
Next i
End Sub
Besten Dank
und mfg
STeve

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Mappe (mit Index) fortlaufend speichern
11.01.2019 19:12:39
Sepp
Hallo Steve,
als Beispiel.
Modul Modul1
Option Explicit 
 
Sub speichern() 
  Dim strPath       As String 
  Dim strFile       As String 
  Dim strNewFile    As String 
   
  strPath = ThisWorkbook.Path 
  strFile = Split(Split(ThisWorkbook.Name, ".")(0), "_")(0) 
   
  strFile = strFile & "($)." & Split(ThisWorkbook.Name, ".")(1) 
 
  strNewFile = NextFileIndexName(strPath, strFile, "_0", 1) 
 
  If Len(strNewFile) Then 
    MsgBox "Die Datei '" & strNewFile & "' wird neu angelegt!" 
    ActiveWorkbook.SaveAs Filename:=strNewFile 
  Else 
    MsgBox "Fehler" 
  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 
 

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


 ABCDEF
1Gruß Sepp
2
3

Anzeige
Noch nicht ganz......
12.01.2019 09:23:35
STeve
Guten Morgen Sepp.......Danke für deine schnelle Antwort und deinen Code aber:
strFile = Split(Split(ThisWorkbook.Name, ".")(0), "_")(0)
....schneidet mir den Namen nach wenigen Buchstaben ab:
weil Dateiname:
DPL_Bezeichnung_Bezeichnung_Bezeichung_Bezeichnung_usw..... bis zu: .xlsm
strFile ist dann eben nur: DPL
Habe versucht - damit es erst ab dem . spiltet - zu ändern auf:
strFile = Split(ThisWorkbook.Name, ".")(0)
....aber dann werden die neuen Dateien nicht wie bei deinem Code mit:
Name _1
Name _2
Name _3
gespeichert sondern so:
Name_1
Name_1_1
Name_1_1_1
Bitte nochmal um Hilfe.
Danke und mfg
STeve
Anzeige
AW: Noch nicht ganz......
12.01.2019 10:10:20
Sepp
Hallo Steve,
dann so:
Modul Modul1
Option Explicit 
 
Sub speichern() 
  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 "Fehler" 
  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 
 

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


 ABCDEF
1Gruß Sepp
2
3

Anzeige
Jetzt pfeift es......Danke dir und PS:
12.01.2019 10:41:35
STeve
Tausend Dank.........jetzt perfekt.....Schönen Sonntag dir noch lieber Sepp.
PS:(muss mal gesagt werden)
Dachte mir - könnte mit ein "paar" Codezeilen mein Vorhaben "mal schnell" realisieren. Aber dein Code hat mir wieder gezeigt wie wenig Ahnung ich von VBA habe und wie viel ich noch lernen muss. :-(
Super dass solche "tollen und netten" Helfer - wie du - so uneigennützig - uns(und da sprech ich sicher von vielen)hier so "retten".
mfg
STeve

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige