Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen

Doppelte Anlage des Verzeichnisses verhindern | Herbers Excel-Forum


Betrifft: Doppelte Anlage des Verzeichnisses verhindern von: Rainer
Geschrieben am: 14.11.2009 15:45:54

Hallo,

mit viel Mühe habe ich nun das Speichern mit folgendem Code hinbekommen.

Public Sub SpeichernUnter()

    Dim strVerzeichnis As String
    Dim strUVZ
    Dim strDatum As String
    Dim strUhrzeit As String
    Dim strDateiname As String
       
    strUVZ = Sheets("Hilfen").Range("K28")
        ' anhängenden Backslash abtrennen:
        strUVZ = Right(strUVZ, Len(strUVZ) - 1)
    
        ' Verzeichnis auf Existenz prüfen und bei Bedarf neu anlegen:
        If Dir(strUVZ, vbDirectory) = "" Then
          MkDir strUVZ
          CreateDirectory = DirectoryCreated
        Else
          CreateDirectory = DirectoryAlreadyExisted
        End If
        
    strVerzeichnis = Sheets("intern").Range("H33")
        
        ChDir strVerzeichnis
    
    strDatum = Format(Sheets("Erfassung").Range("U20").Value, "yyyy.mm.dd")
    strUhrzeit = Format(Sheets("Erfassung").Range("AG20").Value, "hh:mm")
    strDateiname = Application.GetSaveAsFilename _
                     (Title:="Test", _
            InitialFileName:="Turnierplan " & strDatum & " - " & strUhrzeit & ".xls", _
                 FileFilter:="Microsoft Excel-Arbeitsmappe (*.xls), *.xls")

    Select Case strDateiname
        Case False
            Exit Sub
        Case Else
            ThisWorkbook.SaveAs Filename:=strDateiname
    End Select
End Sub
Nun möchte ich verhindern möchte, dass mit erneutem Click auf den [Button Speichern unter ...] das Verzeichnis erneut angelegt wird und so z. B. ...\Turnierplan\Turnierplan\Turnierplan entsteht.

Im Grunde müsste irgendwo ein

Wenn strUVZ = Verzeichnis dieser Tabelle
dann nicht nochmal strUVZ anlegen stehen

oder

Wenn Dateiname = "Turnierplan " & strDatum & " - " & strUhrzeit & ".xls",
dann kein neues Verzeichnis und nur soll bestehende Datei überschrieben werden

Habe viele Codes mit ERRORHÄNDLER gesehen, aber den hab ich selbst noch nie eingebaut bekommen.

Liege ich mit einer solchen Funktion richtig?

Gruß Rainer

  

Betrifft: Nachfrage von: Tino
Geschrieben am: 14.11.2009 16:07:05

Hallo,
was steht in der Zelle Sheets("Hilfen").Range("K28"), steht da ein kompletter Pfad?


Gruß Tino


  

Betrifft: AW: Nachfrage von: Rainer
Geschrieben am: 14.11.2009 17:05:10

Hallo Tino,

nein, da steht nur

/Turnierplanung 2009
drin

Gruß Rainer


  

Betrifft: versuche es mal so... von: Tino
Geschrieben am: 14.11.2009 17:23:32

Hallo,

Ändere aber /Turnierplanung 2009 noch in \Turnierplanung 2009.

Habe ich jetzt aber nicht getestet.

Private Declare Function apiCreateFullPath Lib "imagehlp.dll" _
Alias "MakeSureDirectoryPathExists" (ByVal lpPath As String) As Long

Public Sub SpeichernUnter()
Dim strVerzeichnis As String
Dim strUVZ
Dim strDatum As String
Dim strUhrzeit As String
Dim strDateiname As String
Dim LPath As Long
        
        strUVZ = IIf(Right$(ThisWorkbook.Path, 1) = "\", Left$(ThisWorkbook.Path, Len(ThisWorkbook.Path) - 1), ThisWorkbook.Path)
        strUVZ = strUVZ & Sheets("Hilfen").Range("K28")
        strUVZ = IIf(Right$(strUVZ, 1) = "\", strUVZ, strUVZ & "\")
        
        'Verzeichnis anlegen falls nicht vorhanden 
        LPath = apiCreateFullPath(strUVZ)
        
        If LPath = 0 Then 'wurde Ordner angelegt oder gefunden? 
         MsgBox "Ordner '" & strUVZ & "' konnte nicht gefunden oder erstellt werden!"
         Exit Sub
        End If
        
        strVerzeichnis = Sheets("intern").Range("H33")
        
        ChDrive Left$(strVerzeichnis, 2) 'auf Laufwerk einloggen, eventuell löschen. 
        ChDir strVerzeichnis 'in Verzeichnis einloggen 
    
        strDatum = Format(Sheets("Erfassung").Range("U20").Value, "yyyy.mm.dd")
        strUhrzeit = Format(Sheets("Erfassung").Range("AG20").Value, "hh:mm")
    
        strDateiname = Application.GetSaveAsFilename(Title:="Test", _
                InitialFileName:="Turnierplan " & strDatum & " - " & strUhrzeit & ".xls", _
                FileFilter:="Microsoft Excel-Arbeitsmappe (*.xls), *.xls")

        
        Select Case strDateiname
            Case CStr(False)
                Exit Sub
            Case Else
                ThisWorkbook.SaveAs Filename:=strDateiname
        End Select

End Sub
Gruß Tino


  

Betrifft: AW: versuche es mal so... von: Rainer
Geschrieben am: 14.11.2009 18:16:40

Hallo Tino,

den \ hatte ich, habe ich vorher falsch eingegeben.

Geht noch nicht, aber ich denke es liegt daran, dass die Variable strVerzeichnis den kompletten Pfad c:\...~Starttabelle\Turnierplanung 2009 enthält.

Alternativ steht die Verwendung der Zelle "intern!E31" zur Verfügung. Diese enthält nur die Pfadangabe C:\...~Starttabelle

Wenn ich für Variable strVerzeichnis allerdings die Zelle "intern!E31" auswähle wird das Unterverzeichnis \Turnierplanung 2009 nicht geöffnet.
Angelegt ist es jedoch.

Gruß Rainer


P.S: Muss mal ne Pause einlegen.
War wohl zuviel Programmierung für mich als VBA-Laie.

Denke aber mit Deiner Ergänzung komme ich noch dahinter.
Solltest Du es auf die schnelle haben würde ich mich natürlich auch freuen.


  

Betrifft: AW: versuche es mal so... von: Tino
Geschrieben am: 14.11.2009 18:29:11

Hallo,

ChDrive Left$(strVerzeichnis, 2)
diese Zeile Logt sich auf das Laufwerk ein
Also steht da eigentlich z. Bsp.: ChDrive "C:"

strVerzeichnis ist doch der Ordner den wir oben im Code Anlegen oder Prüfen ob vorhanden (richtig?),
somit müsste dies doch auch gehen.

Private Declare Function apiCreateFullPath Lib "imagehlp.dll" _
Alias "MakeSureDirectoryPathExists" (ByVal lpPath As String) As Long

Public Sub SpeichernUnter()
Dim strUVZ As String
Dim strDatum As String
Dim strUhrzeit As String
Dim strDateiname As String
Dim LPath As Long
        
        strUVZ = IIf(Right$(ThisWorkbook.Path, 1) = "\", Left$(ThisWorkbook.Path, Len(ThisWorkbook.Path) - 1), ThisWorkbook.Path)
        strUVZ = strUVZ & Sheets("Hilfen").Range("K28")
        strUVZ = IIf(Right$(strUVZ, 1) = "\", strUVZ, strUVZ & "\")
        
        'Verzeichnis anlegen falls nicht vorhanden 
        LPath = apiCreateFullPath(strUVZ)
        
        If LPath = 0 Then 'wurde Ordner angelegt oder gefunden? 
         MsgBox "Ordner '" & strUVZ & "' konnte nicht gefunden oder erstellt werden!"
         Exit Sub
        End If
        
       
        ChDrive Left$(strUVZ, 2) 'auf Laufwerk einloggen (Bsp. ChDrive "C:") 
        ChDir strUVZ 'in Verzeichnis einloggen (Bsp. ChDrive "C:\Ordner\Ordner\Turnierplanung 2009\") 
    
        strDatum = Format(Sheets("Erfassung").Range("U20").Value, "yyyy.mm.dd")
        strUhrzeit = Format(Sheets("Erfassung").Range("AG20").Value, "hh:mm")
    
        strDateiname = Application.GetSaveAsFilename(Title:="Test", _
                InitialFileName:="Turnierplan " & strDatum & " - " & strUhrzeit & ".xls", _
                FileFilter:="Microsoft Excel-Arbeitsmappe (*.xls), *.xls")

        
        Select Case strDateiname
            Case CStr(False)
                Exit Sub
            Case Else
                ThisWorkbook.SaveAs Filename:=strDateiname
        End Select

End Sub
Gruß Tino


  

Betrifft: AW: versuche es mal so... von: Rainer
Geschrieben am: 14.11.2009 19:13:01

Hallo Tino,

erst einmal vielen Dank für Deine Mithilfe.

Das erste mal speichern geht auch.
Wenn ich jedoch bei der "neu gespeicherten" Datei erneut auf [Speichern unter ...] klicke wird wieder ein Verzeichnis angelegt.

Also Start bei c:\...~Starttabelle\Turnierplan.xls
1. Speicherung: c:\...~Starttabelle\Turnierplanung 2009\Turnierplan-yyyy.mm.tt~.xls
2. Speicherung: c:\...~Starttabelle\Turnierplanung 2009\Turnierplanung 2009\Turnierplan-yyyy.mm.tt~.xls

Prüfung müsste als sein:
Befindet sich Tabelle in einem Verzeichnis Namens \Turnierplanung 2009 = Zelle Hilfen!K28 bzw. strUVZ,
dann nicht nochmal Verzeichnis strUVZ anlegen.

Denke mal, dass Deine Abfrage innerhalb \Turnierplanung 2009 abfrägt und da ist ja keine Verzeichnis mit \Turnierplanung 2009 angelegt.

Gruß Rainer


  

Betrifft: jetzt verstehe ich (glaube ich ;-) ) von: Tino
Geschrieben am: 14.11.2009 19:20:10

Hallo,
, die Datei mit dem Code kann einmal aus dem
Ordner \Turnierplanung 2009 ausgeführt werden und
ein anderes Mal aus dem Übergeordneten Ordner.

Vielleicht können wir es so lösen indem wir Prüfen wo sich die Datei gerade befindet die den Code ausführt und entsprechend den Pfad anpassen.

Option Explicit

Private Declare Function apiCreateFullPath Lib "imagehlp.dll" _
Alias "MakeSureDirectoryPathExists" (ByVal lpPath As String) As Long

Public Sub SpeichernUnter()
Dim strUVZ As String
Dim strDatum As String
Dim strUhrzeit As String
Dim strDateiname As String
Dim LPath As Long
        
        strUVZ = IIf(Right$(ThisWorkbook.Path, 1) = "\", Left$(ThisWorkbook.Path, Len(ThisWorkbook.Path) - 1), ThisWorkbook.Path)
        
        With Sheets("Hilfen").Range("K28")
            If Right$(strUVZ, Len(.Value)) <> .Value Then
                strUVZ = strUVZ & IIf(Left$(.Value, 1) = "\", .Value, "\" & .Value)
            End If
            strUVZ = IIf(Right$(strUVZ, 1) = "\", strUVZ, strUVZ & "\")
        End With
        
        'Verzeichnis anlegen falls nicht vorhanden 
        LPath = apiCreateFullPath(strUVZ)
        
        If LPath = 0 Then 'wurde Ordner angelegt oder gefunden? 
         MsgBox "Ordner '" & strUVZ & "' konnte nicht gefunden oder erstellt werden!"
         Exit Sub
        End If
        
       
        ChDrive Left$(strUVZ, 2) 'auf Laufwerk einloggen (Bsp. ChDrive "C:") 
        ChDir strUVZ 'in Verzeichnis einloggen (Bsp. ChDrive "C:\Ordner\Ordner\Turnierplanung 2009\") 
    
        strDatum = Format(Sheets("Erfassung").Range("U20").Value, "yyyy.mm.dd")
        strUhrzeit = Format(Sheets("Erfassung").Range("AG20").Value, "hh:mm")
    
        strDateiname = Application.GetSaveAsFilename(Title:="Test", _
                InitialFileName:="Turnierplan " & strDatum & " - " & strUhrzeit & ".xls", _
                FileFilter:="Microsoft Excel-Arbeitsmappe (*.xls), *.xls")

        
        Select Case strDateiname
            Case CStr(False)
                Exit Sub
            Case Else
                ThisWorkbook.SaveAs Filename:=strDateiname
        End Select

End Sub
Gruß Tino


  

Betrifft: AW: jetzt verstehe ich (glaube ich ;-) ) von: Rainer
Geschrieben am: 14.11.2009 19:56:37

Hallo Tino,

ja genau, habe eine Starttabelle und wenn diese mit Daten befüllt ist macht es ja Sinn, diese getrennt von der Starttabelle als extra Tabelle und zur besseren Übersicht in einem Unterverzeichnis zu speichern.

Wenn ich aber dann an der neuen Tabelle weiter arbeite soll sich das Unterverzeichnis nicht noch einmal angelegt werden.

Hatte selbst auch schon eine Idee.
Hätte Deine vorherige Variante als Makro1 genommen und ein Makro2 mit "nur" speichern angelegt und dann im CommandButton wenn UVZ="VZ der Datei", dann Makro1 sonst Makro2 hinterlegt.

Aber teste mal gleich Deine neue Variante.

Gruß Rainer


  

Betrifft: AW: jetzt verstehe ich (glaube ich ;-) ) von: Rainer
Geschrieben am: 14.11.2009 20:00:55

Hallo Tino,

im neuen Code habe ich einen Fehler und die Programmierung hält beim letzten Befehl

                ThisWorkbook.SaveAs Filename:=strDateiname
Gruß Rainer


  

Betrifft: welcher Fehler... von: Tino
Geschrieben am: 14.11.2009 20:11:39

Hallo,
was für ein Fehler kommt?

Gruß Tino


  

Betrifft: AW: jetzt verstehe ich (glaube ich ;-) ) von: Rainer
Geschrieben am: 14.11.2009 20:09:38

Hallo Tino,

habe "Debuggen"-Fehlermeldung lokalisiert.

Liegt am Zeitformat. UHRZEIT lässt sich nicht mit : speichern.

Gruß Rainer


  

Betrifft: mach einen Unterstrich von: Tino
Geschrieben am: 14.11.2009 20:13:02

Hallo,

strDatum = Format(Sheets("Erfassung").Range("U20").Value, "yyyy_mm_dd")
strUhrzeit = Format(Sheets("Erfassung").Range("AG20").Value, "hh_mm")

Gruß Tino


  

Betrifft: AW: mach einen Unterstrich von: Rainer
Geschrieben am: 14.11.2009 20:15:18

Hallo Tino,

habe Uhrzeit schon als Format HH.MM geändert.

Funktioniert nun einwandfrei.

Vielen Dank für Deine Mithilfe.

Gruß und schönen Abend noch

Rainer


  

Betrifft: Punkt im Dateinamen von: Tino
Geschrieben am: 14.11.2009 21:10:40

Hallo,
gut das es funktioniert, ich weis nur nicht ob es geschickt ist Punkte im Namen zu verwenden.
Dieser dient ja normalerweise als Trennung zwischen Namen und Dateiextension.

Gruß Tino


  

Betrifft: AW: Punkt im Dateinamen von: Rainer
Geschrieben am: 15.11.2009 09:39:45

Hallo Tino,

sorry, habe dann gestern Abend schluß gemacht.

Also bis dato hatte ich kein Problem mit Punkten im Dateinamen.
Da ich aber in diesem Fall die Tabelle anderen zur Verfügung stelle ändere ich es vorsichtshalber ab.

Gruß und nochmal vielen Dank für Deine Mithilfe.

Rainer


Beiträge aus den Excel-Beispielen zum Thema "Doppelte Anlage des Verzeichnisses verhindern"