Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 06:38:45
Kumulierte Daten für Intervalllaufeinheiten
24.04.2024 04:37:43
Mit Word erstellte PDF als Anhang an E-Mail anhängen
24.04.2024 00:20:14
Bestimmte Spalten als xls exportieren per Makro
23.04.2024 22:08:10
Auflisten in Spalte VBA
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1116to1120
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1116to1120
1116to1120
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Doppelte Anlage des Verzeichnisses verhindern

Doppelte Anlage des Verzeichnisses verhindern
Rainer
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
Nachfrage
14.11.2009 16:07:05
Tino
Hallo,
was steht in der Zelle Sheets("Hilfen").Range("K28"), steht da ein kompletter Pfad?
Gruß Tino
AW: Nachfrage
14.11.2009 17:05:10
Rainer
Hallo Tino,
nein, da steht nur 

/Turnierplanung 2009
drin
Gruß Rainer
versuche es mal so...
14.11.2009 17:23:32
Tino
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
Anzeige
AW: versuche es mal so...
14.11.2009 18:16:40
Rainer
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.
Anzeige
AW: versuche es mal so...
14.11.2009 18:29:11
Tino
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
Anzeige
AW: versuche es mal so...
14.11.2009 19:13:01
Rainer
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
Anzeige
jetzt verstehe ich (glaube ich ;-) )
14.11.2009 19:20:10
Tino
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
Anzeige
AW: jetzt verstehe ich (glaube ich ;-) )
14.11.2009 19:56:37
Rainer
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
Anzeige
AW: jetzt verstehe ich (glaube ich ;-) )
14.11.2009 20:00:55
Rainer
Hallo Tino,
im neuen Code habe ich einen Fehler und die Programmierung hält beim letzten Befehl
                ThisWorkbook.SaveAs Filename:=strDateiname
Gruß Rainer
welcher Fehler...
14.11.2009 20:11:39
Tino
Hallo,
was für ein Fehler kommt?
Gruß Tino
AW: jetzt verstehe ich (glaube ich ;-) )
14.11.2009 20:09:38
Rainer
Hallo Tino,
habe "Debuggen"-Fehlermeldung lokalisiert.
Liegt am Zeitformat. UHRZEIT lässt sich nicht mit : speichern.
Gruß Rainer
mach einen Unterstrich
14.11.2009 20:13:02
Tino
Hallo,
strDatum = Format(Sheets("Erfassung").Range("U20").Value, "yyyy_mm_dd")
strUhrzeit = Format(Sheets("Erfassung").Range("AG20").Value, "hh_mm")
Gruß Tino
Anzeige
AW: mach einen Unterstrich
14.11.2009 20:15:18
Rainer
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
Punkt im Dateinamen
14.11.2009 21:10:40
Tino
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
AW: Punkt im Dateinamen
15.11.2009 09:39:45
Rainer
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
Anzeige

Links zu Excel-Dialogen

CommandButton

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige