Filexist - für gesamten Pfad | HERBERS Excel Forum

Mahlzeit und Guten Tag die Damen und Herren,
Meine Exceldatei speichert sich selbst unter einem Dateinamen, der nicht freiwählbar ist, sich jedoch durch die eingebene Auftragsnummer definiert. Jetzt war mein Problem, was bereits gelöst wurde, dass wenn er bei der Speicherung feststellt, dass die Datei bereits vorhanden ist, die Windwos typische Nachfrage gibt, ob die Datei überschrieben werden soll. Wird nun auf nein geklickt, dann erscheint eine Fehlermeldung von VBA, dass die 'SaveAs' Methode fehlgeschlagen ist (klar, denn er konnte sie ja nicht ausführen). Nun wird die Datei unter einem bestimmten, festlegbaren Pfad gespeichert! Allersdings nur, wenn der Ordner in dem gespeichert werden soll auch existiert. Anderenfalls gibt es wieder eine Fehlermeldung. Nun meine Frage:
Wie kann ich automatisch Ordner anlegen oder wenigstens überprüfen, ob der Pfad überhaupt existiert?
MfG Uwe

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub ttt() Dim strVerzeichnis$ Dim var As Variant Dim sFiles As String strVerzeichnis = "c:\test\" 'Überprüfen ob Verzeichnis vorhanden If Dir(strVerzeichnis, vbDirectory) "" Then 'Laufwerk wechseln ChDrive (Left(strVerzeichnis, 2)) 'Verzeichnis wechseln ChDir (strVerzeichnis) 'Datei wählen sFiles = "TXT Files (*.TXT) , *.TXT" var = Application.GetOpenFilename(sFiles) If var = False Then Exit Sub MsgBox var Else Exit Sub End If End Sub

Option Explicit Sub Test() Dim sFile As String sFile = DateiÖffnen("u:\wzm\haffner", "TXT Files (*.TXT) , *.TXT") If sFile "" Then MsgBox sFile Else MsgBox "Abbruch" End Sub Function DateiÖffnen(sPfad As String, Extension As String) As String Dim var As Variant 'Überprüfen ob Verzeichnis vorhanden If Dir(sPfad, vbDirectory) "" Then 'Laufwerk wechseln ChDrive (Left(sPfad, 2)) 'Verzeichnis wechseln ChDir (sPfad) 'Datei wählen var = Application.GetOpenFilename(Extension) If var = False Then Exit Function DateiÖffnen = var End If End Function

... oder speichern:


Option Explicit
Sub TestÖffnen()
Dim sFile As String
sFile = DateiÖffnen("u:\wzm\haffner", "txt Files (*.txt) , *.txt,Alle Dateien (*.*) , *.*")
If sFile  "" Then MsgBox sFile Else MsgBox "Abbruch"
End Sub
Sub TestSpeichern()
Dim sFile As String
sFile = DateiSpeichern("u:\wzm\haffner", "txt Files (*.txt) , *.txt")
If sFile  "" Then MsgBox sFile Else MsgBox "Abbruch"
End Sub
Function DateiÖffnen(sPfad As String, Extension As String) As String
Dim var As Variant
'Überprüfen ob Verzeichnis vorhanden
If Dir(sPfad, vbDirectory)  "" Then
'Laufwerk wechseln
ChDrive (Left(sPfad, 2))
'Verzeichnis wechseln
ChDir (sPfad)
'Datei wählen
var = Application.GetOpenFilename(fileFilter:=Extension)
If var = False Then Exit Function
DateiÖffnen = var
End If
End Function
Function DateiSpeichern(sPfad As String, Extension As String) As String
Dim var As Variant
'Überprüfen ob Verzeichnis vorhanden
If Dir(sPfad, vbDirectory)  "" Then
'Laufwerk wechseln
ChDrive (Left(sPfad, 2))
'Verzeichnis wechseln
ChDir (sPfad)
'Datei wählen
var = Application.GetSaveAsFilename(fileFilter:=Extension, InitialFilename:="User")
If var = False Then Exit Function
DateiSpeichern = var
End If
End Function

Gruss

Option Explicit Public Type BROWSEINFO hOwner As Long pidlRoot As Long pszDisplayName As String lpszTitle As String ulFlags As Long lpfn As Long lParam As Long iImage As Long End Type Declare Function SHGetPathFromIDList Lib "SHELL32.DLL" _ Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long Declare Function SHBrowseForFolder Lib "SHELL32.DLL" _ Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long Sub Test() Dim sPfad As String sPfad = GetDirectory("Wählen Sie ein Verzeichnis aus:") If sPfad "" Then MsgBox sPfad Else MsgBox "Abbruch" End Sub Function GetDirectory(Msg) As String Dim myInfo As BROWSEINFO Dim myPath As String Dim Root As Long, ID As Long, pos As Integer With myInfo .pidlRoot = 0& .lpszTitle = Msg .ulFlags = &H1 End With ID = SHBrowseForFolder(myInfo) myPath = Space$(512) Root = SHGetPathFromIDList(ByVal ID, ByVal myPath) If Root Then pos = InStr(myPath, Chr$(0)) GetDirectory = Left(myPath, pos - 1) Else GetDirectory = "" End If End Function

Beliebteste Forumthreads (12 Monate)

Filexist - für gesamten Pfad

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread