Office: (Office 2010) Erstellen von Ordner mit Unterordner durch Excel

Helfe beim Thema Erstellen von Ordner mit Unterordner durch Excel in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Hallo zusammen, ich bin auf der suche nach einer Matrix, die mir Ordner + 2 Unterordner automatisch erstellt. Hab schon viel rumgegoogelt aber leider... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von Mike123, 2. August 2016.

Seite 1 von 2

MIKE123

Mike123

Erstellen von Ordner mit Unterordner durch Excel

Hallo zusammen,

ich bin auf der suche nach einer Matrix, die mir Ordner + 2 Unterordner automatisch erstellt.

Hab schon viel rumgegoogelt aber leider meistens nur was zu normalen Ordnern gefunden und nie zu Unterordner. Das mit den Überordnet klappt auch schon wunderbar dank "Case" seinem Code aus dem Officelösungen Forum. Da ich leider überhaupt kein Schimmer von VBA habe bitte ich um Hilfe!

Also nochmal die Aufgabenstellung und der Code den ich bis jetzt habe:

1. Name aus Spalte A herausziehen und Ordner mit gleichem Namen anlegen (klappt schon)
2. In diesen Ordner 2 leere Unterordner einfügen die immer den gleichen Namen haben (A / B )

Code:

Option Explicit
' anpassen !!!MIT abschließendem Backslash "\"
Const strPfad1 As String = "C:\Temp\Montag\Pruefung\"

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

Public Sub Test()
Dim wksSheet As Worksheet
Dim lngLastRow As Long
On Error GoTo Fin
Set wksSheet = ThisWorkbook.Worksheets("Tabelle1") 'anpassen!
With wksSheet
lngLastRow = .Range("A" & .Rows.Count).End(xlUp).Row ' Spalte A
For lngLastRow = 1 To lngLastRow ' ab Zeile 1 also eventuell anpassen
If Trim(.Cells(lngLastRow, 1).Value) "" Then
MakeSureDirectoryPathExists (strPfad1 & .Cells(lngLastRow, 1).Value & "\")

End If
Next lngLastRow
End With
Fin:
Set wksSheet = Nothing
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Vielen Dank im voraus !!

:)

Mike123, 2. August 2016

#1
DAOLIX

daolix

Hallo

ggf. so?

Code:

....
If Trim(.Cells(lngLastRow, 1).Value) "" Then
MakeSureDirectoryPathExists (strPfad1 & .Cells(lngLastRow, 1).Value & "\A\")
MakeSureDirectoryPathExists (strPfad1 & .Cells(lngLastRow, 1).Value & "\B\")
End If
...
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

daolix, 4. August 2016

#2
MIKE123

Mike123

Hallo daolix *Smilie
Das hat ja jetzt super funktioniert. Danke !!

Mike123, 4. August 2016

#3
MIKE123

Mike123

Erstellen von Ordner mit Unterordner durch Excel

Okey also jetzt hab ich noch ein Wunsch *biggrin.gif*

Mein Code bis jetzt
Code:

Option Explicit
' anpassen !!!MIT abschließendem Backslash "\"
Const strPfad1 As String = "C:\Users\Mike\Desktop\Testordner\"

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

Public Sub Test()
Dim wksSheet As Worksheet
Dim lngLastRow As Long
On Error GoTo Fin
Set wksSheet = ThisWorkbook.Worksheets("Tabelle4") 'anpassen!
With wksSheet
lngLastRow = .Range("A" & .Rows.Count).End(xlUp).Row ' Spalte A
For lngLastRow = 4 To lngLastRow ' ab Zeile 1 also eventuell anpassen
If Trim(.Cells(lngLastRow, 1).Value) "" Then
MakeSureDirectoryPathExists (strPfad1 & .Cells(lngLastRow, 1).Value & "\A\")
MakeSureDirectoryPathExists (strPfad1 & .Cells(lngLastRow, 1).Value & "\B\")

End If
Next lngLastRow
End With
Fin:
Set wksSheet = Nothing
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Das klappt auch alles wirklich super und genau so wie ich will *biggrin.gif* jetzt brauche ich noch zusätzlich eine .txt Datei (Name bleibt immer gleich)
und wirklich spitze wäre es wenn automatisch ein Hyperlink von Ordner B in Spalte C eingesetzt werden könnte.

Hoffe das Funktioniert irgendwie *rolleyes.gif*

Mike123, 4. August 2016

#4
DAOLIX

daolix

Hallo

versuch:
Code:

.........
If Trim(.Cells(lngLastRow, 1).Value) "" Then
For Each v In Array("\A\", "\B\")
If MakeSureDirectoryPathExists(strPfad1 & .Cells(lngLastRow, 1).Value & v) Then
Open strPfad1 & .Cells(lngLastRow, 1).Value & v & "DieTextDatei.txt" For Binary As #1
Close #1
End If
Next
End If
.........
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Den Namen der Textdatei musst du noch vergeben.

daolix, 5. August 2016

#5
MIKE123

Mike123

Hallo daolix,

habe das mal versucht einzufügen er zeigt mir aber immer ein Fehler bei dem v an.

Wo genau muss ich das einfügen ?

Mike123, 25. August 2016

#6
XLPH

xlph

Code:

Option Explicit

' anpassen !!!MIT abschließendem Backslash "\"
Const strPfad1 As String = "C:\Users\Mike\Desktop\Testordner\"

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

Public Sub Test()
Dim wksSheet As Worksheet
Dim lngLastRow As Long
Dim lngRow As Long
Dim strFullPath As String

Set wksSheet = ThisWorkbook.Worksheets("Tabelle4") 'anpassen!

With wksSheet
lngLastRow = .Range("A" & .Rows.Count).End(xlUp).Row ' Spalte A
For lngRow = 4 To lngLastRow ' ab Zeile 4 also eventuell anpassen

If Trim(.Cells(lngRow, 1).Value) "" Then

strFullPath = strPfad1 & .Cells(lngRow, 1).Value & "\A\"
Call MakeSureDirectoryPathExists(strFullPath)
Call CreateTxtFile(strFullPath & "Test.txt", "")

strFullPath = strPfad1 & .Cells(lngRow, 1).Value & "\B\"
Call MakeSureDirectoryPathExists(strFullPath)
Call CreateTxtFile(strFullPath & "Test.txt", "")

.Hyperlinks.Add .Cells(lngRow, 3), strFullPath & "Test.txt", , , ">>"

End If

Next lngLastRow
End With

End Sub

Private Sub CreateTxtFile(ByVal strPath As String, ByVal strText As String)
Dim intFF As Integer
intFF = FreeFile()
Open strPath For Input As #intFF
Print #intFF, strText
Close #intFF
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

xlph, 25. August 2016

#7
DAOLIX

daolix

Erstellen von Ordner mit Unterordner durch Excel

Hallo
du must v noch deklarieren

z.b. unter deiner Zeile
Dim lngLastRow As Long
fügst die noch die Zeile
dim v as variant
ein

daolix, 26. August 2016

#8
MIKE123

Mike123

Hi Leute danke für die schnelle Rückmeldung!

daolix hab deins gerade mal ausprobiert und es klappt auch *Smilie
leider nicht so wie ich will... hab mich oben falsch ausgedrückt.

Die .txt Datei sollte parallel zu den Ordnern A und B stehen.

Probiere mal selber ob ich das hinbekomme *Smilie
Für Hilfe wäre ich trotzdem dankbar *tongue.gif*

Mike123, 26. August 2016

#9
DAOLIX

daolix

Hallo
kein Plan was du meinst, ich vermute mal

Code:

LW:\IrgendeinPath
│ EineTextDatei.txt
├───A
└───B
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

dann is der der Code

Code:

.........
If Trim(.Cells(lngLastRow, 1).Value) "" Then
For Each v In Array("\A\", "\B\")
MakeSureDirectoryPathExists(strPfad1 & .Cells(lngLastRow, 1).Value & v)
Next
Open strPfad1 & .Cells(lngLastRow, 1).Value & "\EineTextDatei.txt" For Binary As #1
Close #1
End If
.........
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

daolix, 26. August 2016

#10
XLPH

xlph

Code:

Option Explicit

' anpassen !!!MIT abschließendem Backslash "\"
Const strPfad1 As String = "C:\Users\Mike\Desktop\Testordner\"

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

Public Sub Test()
Dim wksSheet As Worksheet
Dim lngLastRow As Long
Dim lngRow As Long
Dim strFullPath As String

Set wksSheet = ThisWorkbook.Worksheets("Tabelle4") 'anpassen!

With wksSheet
lngLastRow = .Range("A" & .Rows.Count).End(xlUp).Row ' Spalte A
For lngRow = 4 To lngLastRow ' ab Zeile 4 also eventuell anpassen

If Trim(.Cells(lngRow, 1).Value) "" Then

strFullPath = strPfad1 & .Cells(lngRow, 1).Value & "\A\"
Call MakeSureDirectoryPathExists(strFullPath)

strFullPath = strPfad1 & .Cells(lngRow, 1).Value & "\B\"
Call MakeSureDirectoryPathExists(strFullPath)

strFullPath = strPfad1 & .Cells(lngRow, 1).Value & "\"
Call CreateTxtFile(strFullPath & "Test.txt", "")

.Hyperlinks.Add .Cells(lngRow, 3), strFullPath & "Test.txt", , , ">>"

End If

Next lngLastRow
End With

End Sub

Private Sub CreateTxtFile(ByVal strPath As String, ByVal strText As String)
Dim intFF As Integer
intFF = FreeFile()
Open strPath For Input As #intFF
Print #intFF, strText
Close #intFF
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

xlph, 26. August 2016

#11
MIKE123

Mike123

Hallo Zusammen,

danke für die Hilfe und sorry für die späte Rückmeldung war im Urlaub...

daolix auf deine Frage: Ja so wie du das da aufgezeichnet hast ist es richtig...

ich möchte auf höhe der Ordner A und B nur eine Textdatei haben

Bsp.:
Bauteil 1 soll 2 Unterordner und eine Text.txt haben
Code:

LW:\Bauteil1
│
├─── EineTextDatei.txt
├───A
└───B
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

PS bei beiden Code's von euch zeigt er mir ein Fehler mit dem letzten "Next lngLastRow" wenn ich es auf "Next lngRow" abändere macht er mir den ersten Ordner aber das war's dann auch. Dann kommt die Meldung Datei nicht gefunden. Sorry aber ich hab da keine Ahnung *confused.gif*

Danke für eure Geduld !!
MfG Mike

Mike123, 12. September 2016

#12
DAOLIX

daolix

Erstellen von Ordner mit Unterordner durch Excel

Hallo
hier mal vollständig, so wie von dir vorgegeben, läuft bei mir

Code:

Option Explicit
' anpassen !!!MIT abschließendem Backslash "\"
Const strPfad1 As String = "C:\Temp\Montag\Pruefung\"

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

Public Sub Test()
Dim wksSheet As Worksheet
Dim lngLastRow As Long
Dim v As Variant

On Error GoTo Fin
Set wksSheet = ThisWorkbook.Worksheets("Tabelle1") 'anpassen!
With wksSheet
lngLastRow = .Range("A" & .Rows.Count).End(xlUp).Row ' Spalte A
For lngLastRow = 1 To lngLastRow ' ab Zeile 1 also eventuell anpassen
If Trim(.Cells(lngLastRow, 1).Value) "" Then
For Each v In Array("\A\", "\B\") '
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

daolix, 12. September 2016

#13
MIKE123

Mike123

WOW!!
echt super funktioniert alles !*yelrotflmao

Mike123, 13. September 2016

#14
MIKE123

Mike123

Hey daolix,

mein Code sieht jetzt so aus :
Code:

Option Explicit
' anpassen !!!MIT abschließendem Backslash "\"
Const strPfad1 As String = "C:\Users\mike\testordner\"

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

Public Sub OrdnerErstellen()
Dim wksSheet As Worksheet
Dim lngLastRow As Long
Dim v As Variant

On Error GoTo Fin
Set wksSheet = ThisWorkbook.Worksheets("Tabelle1") 'anpassen!
With wksSheet
lngLastRow = .Range("A" & .Rows.Count).End(xlUp).Row ' Spalte A
For lngLastRow = 3 To lngLastRow ' ab Zeile 1 also eventuell anpassen
If Trim(.Cells(lngLastRow, 1).Value) "" Then
For Each v In Array("\A\", "\B\") '
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Mike123, 13. September 2016

#15

(Du musst angemeldet oder registriert sein, um eine Antwort erstellen zu können.)

Seite 1 von 2

Thema:

Erstellen von Ordner mit Unterordner durch Excel

Die Seite wird geladen...

Erstellen von Ordner mit Unterordner durch Excel - Similar Threads - Erstellen Ordner Unterordner
Ordner mit Unterordner per VBA erstellen
in Microsoft Access Hilfe
Ordner mit Unterordner per VBA erstellen: Hallo Leute Ich möchte gerne Order incl. Unterordner per VBA erstellen. Die Namen der Ordner und Unterordner sind in einer Tabelle gespeichert. Mit nachfolgender Prozedur funktioniert es auch ganz...
Verwenden von Ordnern zum Erstellen von schreibgeschützten Dateien für Kursteilnehmer oder ...
in Microsoft Teams Tutorials
Verwenden von Ordnern zum Erstellen von schreibgeschützten Dateien für Kursteilnehmer oder ...: Verwenden von Ordnern zum Erstellen von schreibgeschützten Dateien für Kursteilnehmer oder andere Teammitglieder Microsoft Teams for Education Mehr... Weniger...
Erstellen eines Ordners in Outlook
in Microsoft Outlook Tutorials
Erstellen eines Ordners in Outlook: Erstellen eines Ordners in Outlook Outlook für Microsoft 365 Outlook 2019 Outlook 2016 Outlook 2013 Outlook 2010 Outlook 2007 Mehr......
Erstellen eines neuen Ordners
in Microsoft Word Tutorials
Erstellen eines neuen Ordners: Erstellen eines neuen Ordners Word für Microsoft 365 Word 2019 Word 2016 Word 2013 Mehr... Weniger...
Ordner via Excelliste erstellen und Unterordner hineinkopieren
in Microsoft Excel Hilfe
Ordner via Excelliste erstellen und Unterordner hineinkopieren: Hallo liebe Forumsgemeinde, ich bin seit Tage daran, mir viel Arbeit mittels Automatisierung abzunehmen. Ich habe vor, mir ein Tabellenblatt zu basteln, in dem ich Jahreszahl und...
Ordner erstellen
in Microsoft Access Hilfe
Ordner erstellen: Hallo zusammen, ich bräuchte wieder mal Hilfe mit VBA. Ich habe einen Code der mir einen Ordner in einem Pfad erstellt mit einem bestimmten Namen sofern dieser noch nicht besteht. Das...
Outlook IMAP lokalen Ordner erstellen
in Microsoft Outlook Hilfe
Outlook IMAP lokalen Ordner erstellen: Hallo, mein Webmail-Postfach läuft langsam voll, aber ich möchte keine E-Mails löschen. Wie kann ich die lokal auf meinem Rechner speichern? Immer wenn ich in Outlook (IMAP) einen neuen Ordner...

Anmelden oder registrieren

Suche

Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.

Akzeptieren Weitere Informationen...

Information ausblenden