Verzeichnisse prüfen u. anlegen

Public Sub Speichern_Schließen() Dim fs As Object, OrdNam As Variant, Ord As Byte, pfad As String Dim DateiNam As String Dim Laufw As String Dim ord1 As String Dim ord2 As String Dim ord3 As String Dim ord4 As String Dim LaufwOrd As String Sheets("Lager").Select '-------- Laufwerk --------------------------- Laufw = ActiveSheet.Cells(26, 1).Value & ":\" If Dir(Laufw, 16) "" Then '------- Verzeichnisse entsprechend Center ---- ord1 = ActiveSheet.Cells(27, 1).Value ord2 = ActiveSheet.Cells(28, 1).Value ord3 = ActiveSheet.Cells(29, 1).Value ord4 = ActiveSheet.Cells(24, 1).Value & "\" '------- Laufwerk + Verzeichnisse ----- LaufwOrd = Laufw & ord1 & ord2 & ord3 & ord4 ' MsgBox LaufwOrd '------------ dateiname -------------------- DateiNam = ActiveSheet.Cells(24, 1).Value & " " & _ ActiveSheet.Cells(25, 1).Value & ".xls" End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Walter,
hier eine Funktion EnsureFolderExists, die prueft, ob ein Verz. existiert. Falls nicht, versucht man den Verz. zu bilden. Die Funktion gibt 'true' zurueck, wenn der Verz. vorhanden ist, wenn nicht gibt sie 'false' zurueck.
In der sub test sieht man, wie es funzt.
Hoffe es hilft Dir!
Gruss Dan, cz.
Option Explicit


Public Sub test()
Dim testFolder As String
testFolder = "c:\test123"
Call MsgBox("Folder: " & testFolder & " existiert: " & EnsureFolderExists(testFolder))
testFolder = "abc //?*... ungueltig!!!"
Call MsgBox("Folder: " & testFolder & " existiert: " & EnsureFolderExists(testFolder))
End Sub


Private Function EnsureFolderExists(ByVal fldPathName As String) As Boolean
Dim fld As Object
Dim fso As Object
On Error Resume Next
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
Set fld = Nothing
If (fso.folderExists(fldPathName) = False) Then
Set fld = fso.CreateFolder(fldPathName)
Else
Set fld = fso.GetFolder(fldPathName)
End If
If (Not fld Is Nothing) Then
EnsureFolderExists = True
Else
EnsureFolderExists = False
End If
End Function

Hallo Dan,
habe vorhin auch nochmal in der Recherche dies gefunden und klappt
vorzüglich:
'------------ jetzt prüfen ob die ordner vorhanden sind ------------------
ordAlle = ActiveSheet.Cells(27, 1).Value & ActiveSheet.Cells(28, 1).Value _
& ActiveSheet.Cells(29, 1).Value & ActiveSheet.Cells(24, 1).Value
Dim strOrdner As String, i As Integer
' strOrdner = Range("A1")
strOrdner = ordAlle
If Dir(strOrdner, vbDirectory) = "" Then
For i = 1 To Len(strOrdner)
If Mid(strOrdner, i, 1) = "\" Then
If Dir(Left(strOrdner, i - 1), vbDirectory) = "" Then
MkDir Left(strOrdner, i - 1)
End If
End If
Next
MkDir strOrdner
Else
MsgBox "Laufwerk + Verzeichnisse: " & Laufw & strOrdner & "" & _
Chr(13) & Chr(13) & "sind vorhanden ! " _
& Chr(13) & " ", vbInformation, " Hinweis !"
End If
Danke denoch für deine Unterstützung !!!

Beliebteste Forumthreads (12 Monate)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread