Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

VBA Tabellenblatt speichern und wenn vorhanden neuer Name
#1
Hallo,

ich habe folgendenden VBA Code, mit dem ich Tabellenblätter abspeichern kann.


Code:
Sub LoeschenBestellblaetterundCSVspeichern()
 Dim wks As Worksheet
 Application.ScreenUpdating = False
 For Each wks In ThisWorkbook.Sheets
   If LCase(wks.Name) <> "bestellung" And _
     LCase(wks.Name) <> "bestand" And _
     LCase(wks.Name) <> "ek" Then
     wks.Copy
     ActiveWorkbook.SaveAs "S:\_Vertraege_ET_WIL\Bestelldatei\" & ActiveSheet.Name & " DS", xlCSV, Local:=True
     ActiveWorkbook.Close False
   End If
 Next wks
 Application.ScreenUpdating = True
 MsgBox "Dateien erfolgreich gespeichert"
End Sub

Nun kann es allerdings vorkommen, dass bereits eine Datei mit dem gleichen Namen an dem Speicherort vorhanden ist.
In diesem Fall soll die Datei natürlich nicht überschrieben werden, sondern nach der folgenden Logik abgespeichert werden. 

In einem anderen Forum, habe ich den folgenden Code gefunden:
http://www.office-loesung.de/ftopic412426_0_0_asc.php
Code:
Dateiname
Dateiname (1)
Dateiname (2)

In einem anderen Forum habe ich den folgenden Code gefunden:

Option Explicit

Sub x()
   Dim strFilename As String
   
   strFilename = getName("c:\temp\kw39", ".xls")
   MsgBox strFilename
End Sub

Private Function getName(ByVal strName As String, ByVal strExtension As String) As String
   Dim lngNummer As Long
   
   If Dir(strName & strExtension) = "" Then
      getName = strName & strExtension
   Else
      lngNummer = 1
      While Dir(strName & "_" & lngNummer & strExtension) <> ""
         lngNummer = lngNummer + 1
      Wend
      getName = strName & "_" & lngNummer & strExtension
   End If
End Function

Meine VBA Kentnisse reichen aber bei weitem nicht aus, um eine Verbindung bzw. Verknüpfung der beiden Codes herzustellen.


Möglicherweise habt ihr ja auch ganz andere Lösungsansätze.
Über jegliche Antwort wäre ich sehr dankbar.
Antworten Top
#2
Ungetestet
Code:
Sub LoeschenBestellblaetterundCSVspeichern()
Dim wks As Worksheet, Datei As String, Pfad As String, Zaehler As Integer
Application.ScreenUpdating = False
For Each wks In ThisWorkbook.Sheets
   If LCase(wks.Name) <> "bestellung" And _
   LCase(wks.Name) <> "bestand" And _
   LCase(wks.Name) <> "ek" Then
       wks.Copy
       Pfad = "S:\_Vertraege_ET_WIL\Bestelldatei\"
       Datei = ActiveSheet.Name & " DS"
       
       If Not Dir(Pfad & Datei & ".CSV") = "" Then
          Zaehler = 1
          While Dir(Pfad & Datei & Zaehler) <> ""
             Zaehler = Zaehler + 1
          Wend
          Datei = Datei & Zaehler
       End If
       
       ActiveWorkbook.SaveAs Pfad & Datei, xlCSV, Local:=True
       ActiveWorkbook.Close False
   End If
Next wks
Application.ScreenUpdating = True
MsgBox "Dateien erfolgreich gespeichert"
End Sub

Im Falle, dass die Datei bereits vorhanden ist, wird sie statt unter "Tabelle1 DS" als "Tabelle1 DS1" gespeichert (bzw. DS2, DS3 usw.).
Schöne Grüße
Berni
[-] Folgende(r) 1 Nutzer sagt Danke an MisterBurns für diesen Beitrag:
  • deschroe
Antworten Top
#3
Moin,

vielen lieben Dank.

Es funktioniert.
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste