Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1104to1108
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Viele Verzeichnisse anlegen

Viele Verzeichnisse anlegen
Hannes
Hallo,
ich habe folgendes Problem und leider nichts passendes gefunden im Archiv.
Ich einer Tabelle steht ab A1 bis A500 entweder ein "x" oder "X" oder nichts (Zelle leer).
Ab B1 bis B500 stehen Werte:
z.B. J:\Maschinenbuch\Geraete\322101_Bagger\, J:\Maschinenbuch\Geraete\322102_Kran\,
usw.
Nun soll ein Makro folgendes tun.
Sofern in Spalte A1 bis A500 ein Wert steht "x" oder "X" soll Excel den Wert aus der Spalte B1 nehmen und das entsprechende Verzeichnis erstellen (sofern noch nicht vorhanden").
D.h. das Makro soll ab A1 bis A500 durchprüfen.
Danke für Hilfe
Markus

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

Betreff
Benutzer
Anzeige
So gehts
24.09.2009 21:54:32
Backowe
Hallo Markus,
VBA-Code:
Sub VerzeichnisseAnlegen()
Dim i As Integer
For i = 1 To 500
  If LCase(Cells(i, "A")) = "x" Then
    If Dir(Cells(i, "B"), vbDirectory) = "" Then _
      Shell "cmd /c md " & Cells(i, "B"), vbHide
  End If
Next
End Sub
Gruß Jürgen
AW: So gehts
MichaV

@Jürgen: warum nimmst Du shell und nicht mkdir?
Gruß Micha
Weil ich damit einen Fehler bekommen habe oT
Backowe

AW: Viele Verzeichnisse anlegen
Tino

Hallo,
Du kannst es mal hiermit versuchen.
Private Declare Function apiCreateFullPath _
Lib "imagehlp.dll" Alias "MakeSureDirectoryPathExists" (ByVal lpPath As String) As Long

Sub Anlegen()
Dim meAr
Dim A As Long
Dim lngPahth As Long
Dim strFehler As String

'Bereich eventuell anpassen, hier in der Tabelle1 A1:B500 
meAr = Sheets("Tabelle1").Range("A1:B500")

For A = 1 To Ubound(meAr)
    If LCase(meAr(A, 1)) = "x" Then 'prüfe ob x oder X in Spalte A 
        If Len(meAr(A, 2)) > 3 Then 'prüfe ob Textlänge in B größer 3 
            If Dir(Left(meAr(A, 2), 3)) <> "" Then 'ist Laufwerk vorhanden? 
                  'Alle Ordner und Unterordner anlegen, fals nicht vorhanden 
                  lngPahth = apiCreateFullPath(meAr(A, 2))
                  If lngPahth <> 1 Then 'konnte Ordner nicht angelegt oder gefunden werden? 
                   strFehler = meAr(A, 2) & vbCr 'fehler Sammlung 
                  End If
            End If
        End If
    End If
Next A

If strFehler <> "" Then 'wurde Fehlertext erstellt? 
 MsgBox "Die Ordner konnten nicht angelegt werden" & vbCr & vbCr & strFehler, vbCritical
Else
 MsgBox "Alle Ordner wurden angelegt", vbInformation
End If

End Sub
Gruß Tino
Anzeige
AW: So gehts
24.09.2009 22:07:46
MichaV
@Jürgen: warum nimmst Du shell und nicht mkdir?
Gruß Micha
Weil ich damit einen Fehler bekommen habe oT
24.09.2009 22:10:21
Backowe
AW: Viele Verzeichnisse anlegen
24.09.2009 23:40:43
Tino
Hallo,
Du kannst es mal hiermit versuchen.
Private Declare Function apiCreateFullPath _
Lib "imagehlp.dll" Alias "MakeSureDirectoryPathExists" (ByVal lpPath As String) As Long

Sub Anlegen()
Dim meAr
Dim A As Long
Dim lngPahth As Long
Dim strFehler As String

'Bereich eventuell anpassen, hier in der Tabelle1 A1:B500 
meAr = Sheets("Tabelle1").Range("A1:B500")

For A = 1 To Ubound(meAr)
    If LCase(meAr(A, 1)) = "x" Then 'prüfe ob x oder X in Spalte A 
        If Len(meAr(A, 2)) > 3 Then 'prüfe ob Textlänge in B größer 3 
            If Dir(Left(meAr(A, 2), 3)) <> "" Then 'ist Laufwerk vorhanden? 
                  'Alle Ordner und Unterordner anlegen, fals nicht vorhanden 
                  lngPahth = apiCreateFullPath(meAr(A, 2))
                  If lngPahth <> 1 Then 'konnte Ordner nicht angelegt oder gefunden werden? 
                   strFehler = meAr(A, 2) & vbCr 'fehler Sammlung 
                  End If
            End If
        End If
    End If
Next A

If strFehler <> "" Then 'wurde Fehlertext erstellt? 
 MsgBox "Die Ordner konnten nicht angelegt werden" & vbCr & vbCr & strFehler, vbCritical
Else
 MsgBox "Alle Ordner wurden angelegt", vbInformation
End If

End Sub
Gruß Tino
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige