Verzeichnisse aus Zellen schreiben

Sub ordner_pruefen_und_anlegen() Dim sVerz As String Dim strname As String Dim strnummer As String For i = 2 To 1000 strname = Cells(i, 1) sVerz = PROBLEM NR 1. :der Pfad für das Hauptverzeichnis steht in Zelle N8 (Hier stand ein _ fester Pfad, der soll dynamisch sein und liegt deswegen in der Zelle N8) If sVerz = "" Then MkDir... Next i End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Maris,
teste mal:

Option Explicit

Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
    ByVal DirPath As String) As Long

Public Sub CreateFolders()
    Dim strFolder As String, strSubFolder As String
    Dim lngRow As Long, lngReturn As Long
    With Worksheets("Datentabelle")
        strFolder = .Cells(3, 14).Text
        For lngRow = 6 To .Cells(.Rows.Count, 22).End(xlUp).Row
            strSubFolder = .Cells(lngRow, 22).Text
            If Right$(strSubFolder, 1) <> "\" Then strSubFolder = strSubFolder & "\"
            strSubFolder = Replace(strSubFolder, "/", "\")
            lngReturn = MakeSureDirectoryPathExists(strFolder & strSubFolder)
            If lngReturn = 0 Then
                Call MsgBox("Fehler beim Erstellen des Ordners.", vbCritical, "Dateisystemfehler")
                Exit For
            End If
        Next
    End With
End Sub

Gruß
Nepumuk

Hallo Maris,
so?

Option Explicit

Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
    ByVal DirPath As String) As Long

Public Sub CreateFolders()
    Dim strFolder As String, strSubFolder As String
    Dim lngRow As Long, lngReturn As Long
    With Worksheets("Datentabelle")
        strFolder = .Cells(3, 14).Text
        If Right$(strFolder, 1) <> "\" Then strFolder = strFolder & "\"
        For lngRow = 6 To .Cells(.Rows.Count, 22).End(xlUp).Row
            strSubFolder = .Cells(lngRow, 22).Text
            If Right$(strSubFolder, 1) <> "\" Then strSubFolder = strSubFolder & "\"
            strSubFolder = Replace(strSubFolder, "/", "\")
            lngReturn = MakeSureDirectoryPathExists(strFolder & strSubFolder)
            If lngReturn = 0 Then
                Call MsgBox("Fehler beim Erstellen des Ordners.", vbCritical, "Dateisystemfehler")
                Exit For
            End If
        Next
    End With
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

Verzeichnisse aus Zellen schreiben

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread