Jun 30, 2009, updated at 07:41:26 (UTC)

5589

Ordner anlegen per VBS mit NAmen aus Tabelle

Wie mein Titel schon sagt, möchte ich Ordner anlegen mit Namen aus einer Tabelle

was ich schon habe ist

Sub CommandButton1_Click()

Dim intIndex As Integer

For intIndex = 3 To 15
  MkDir ("P:\Datenaustausch\Konstruktion\Ordner\" & Range("B" & intIndex).Value)  
Next intIndex

End Sub

klappt an sich auch schon sehr gut. Doch wenn ihr euch die dazugehörige Tabelle anschaut, merkt ihr dass es eine Problematik gibt.

10-000 MASCHINENBAU
10-200 Fertigungskomponenten
10-210 Grundrahmen Tankanlagen
10-220 Abdeckungen_Seitenwände
10-225 Isolierungen Thermisch
10-230 Gusstteile (z.B. Schmelzbehälter)
11-000 SCHMELZSYSTEME
11-110 Tanksysteme mit Kolbenpumpen 1
11-112 Tanksysteme mit Kolbenpumpen 2
11-120 Tanksysteme mit Kolbenpumpen 3
11-200 Tanksysteme mit Kolbenpumpen sonstige
12-110 Tanksysteme mit Zahnradpumpen 1
12-120 Tanksysteme mit Zahnradpumpen 2
12-200 Tanksysteme mit Zahnradpumpen Spezial

Ich hab eine Spalte Produktnummern und eine Spalte Bezeichnung. Jetzt ist es so, dass ich immer eine Nummer habe "XX-000" das ist sozusagen der Überordner und alles was nachfolgend kommt, gehört in den Ordner darunter. Problematisch wirds, da es auch sein kann dass es mehrere Ebenen gibt zB.

Maschinenbau
        |
        |------------Fertigungskomponenten
                          |------------ Grundrahmen
                          |------------ Abdeckung
                          |------------ Isolierung
                          |------------ Gußteile

Schmelzsysteme
         |
[usw...]

Hat einer ne hilftreiche Idee wie ich das bewerkstelligen kann?

Muss dazu sagen, bin in VBS ne Niete ;)

Please also mark the comments that contributed to the solution of the article

Content-Key: 119378

Url: https://administrator.de/contentid/119378

Printed on: April 18, 2024 at 23:04 o'clock

4 Comments

Latest comment

ok, hab mitlerweile das hier

Sub CommandButton1_Click()

Dim intIndex As Integer

For intIndex = 3 To 4

If Range("A" & intIndex) Like "*000" Then  
MkDir ("P:\Datenaustausch\Konstruktion\Ordner\" & Range("B" & intIndex).Value)  
Else
MkDir ("P:\Datenaustausch\Konstruktion\Ordner\" & Range("B" & intIndex - 1).Value & "\" & Range("B" & intIndex).Value)  

End If

Next intIndex

End Sub

jetzt macht er nur ein Fehler, da er jaimmer nur ein Zähler zurücksetzt... er muss ja aber solange den zähler zurücksetzten, bis er den Oberordner wieder hat.
Das Problem dann aber, wie soll er dann die Nächse Zeile verarbeiten?? Hach, is das alles schwierig

so, habs jetzt... zumindest für zwei Ebenen

Sub CommandButton1_Click()

Dim intIndex As Integer

For intIndex = 3 To 15

If Range("A" & intIndex) Like "*000"   
Then
          MkDir ("P:\Datenaustausch\Konstruktion\Ordner\" & Range("B" & intIndex).Value)  
          Merker = 0

Else
          Merker = Merker + 1
          MkDir ("P:\Datenaustausch\Konstruktion\Ordner\" & Range("B" & intIndex - Merker).Value & "\" & Range("B" & intIndex).Value)  

End If

Next intIndex

End Sub

Probiers einmal hiermit:

Sub CommandButton1_Click()
   Dim strVerz(4)     As String
   Dim strNR(4)       As String
   Dim strAktuell    As String
   Dim intEbene      As Integer
   Dim intZeile      As Integer
   Dim strAusgabe    As String
   Dim i             As Integer
   intEbene = 0
   
   'Startzeile  
   intZeile = 3
   
   'Solange in Zelle B ein Wert vorhanden  
   While Range("B" & intZeile).Value <> ""  
      strZellentext = Mid(Range("B" & intZeile).Value, 8)  
      strAktuell = Left(Range("B" & intZeile).Value, 6)  
      
      'Ebene ermitteln  
      If Left(strAktuell, 2) <> strNR(0) Then
         intEbene = 0
         strNR(0) = Left(strAktuell, 2)
      ElseIf Mid(strAktuell, 1, 4) <> strNR(1) Then
         intEbene = 1
         strNR(1) = Mid(strAktuell, 1, 4)
      ElseIf Mid(strAktuell, 1, 5) <> strNR(2) Then
         intEbene = 2
         strNR(2) = Mid(strAktuell, 1, 5)
      ElseIf Mid(strAktuell, 1, 6) <> strNR(3) Then
         intEbene = 3
         strNR(3) = Mid(strAktuell, 1, 6)
      End If
      
      'Verzeichnisname merken  
      strVerz(intEbene) = strZellentext
      
      'Pfad zumsammenbasteln  
      strAusgabe = ""  
      For i = 0 To intEbene
         strAusgabe = strAusgabe + strVerz(i) + "\"  
      Next i
      
      'Pfad um den letzten Backslash kürzen  
      strAusgabe = Left(strAusgabe, Len(strAusgabe) - 1)
     
      MkDir ("P:\Datenaustausch\Konstruktion\Ordner\" & strAusgabe)  
      
      'Zeilenzähler erhöhen  
      intZeile = intZeile + 1

   Wend
   
End Sub

Gruß Rüdiger aus Kiel

... oder noch ein Ansatz (falls es so zu verstehen wäre, dass alle Ordnerebenen durch "-" voneinander getrennt sind, also es zB "XX-YYY-ZZZZ" geben kann ([Edit] Bei nochmaliger Betrachtung der Struktur wird's wohl nicht so sein - ich lass' den Code aber trotzdem stehen ... [/Edit]):

BasisPfad = "P:\Datenaustausch\Konstruktion\Ordner"  
Set fso = CreateObject("Scripting.FileSystemObject")  
...
PfadUndName = Cells(intZeile, "A")  
NurPfad = Split(PfadUndName)(0)
NurName = Trim(Mid(PfadUndName, Len(NurPfad)))

OrdnerPfad = Basispfad
AlleOrdner = Split(NurPfad, "-")  
For i = 0 To UBound(AlleOrdner)
    OrdnerPfad = OrdnerPfad & "\" & AlleOrdner(i)  
    If Not fso.FolderExists(OrdnerPfad) Then fso.CreateFolder(OrdnerPfad)
Next
...

Grüße
bastla

German solved Question VB for Applications Development

Hotly discussed

How to set up and configure a Linux GRE tunnelAlexWisha - 3 Comments

WIREGUARD VPN ON UDM PRO BEHIND FRITZBOX - HANDSHAKE DID NOT COMPLETEjstricker - 1 Comment

End of Support dates for Office 2016, 2019 Apps und Productivity ServersDani - 1 Comment