shitzovran
Goto Top

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 ;)

Content-ID: 119378

Url: https://administrator.de/forum/ordner-anlegen-per-vbs-mit-namen-aus-tabelle-119378.html

Ausgedruckt am: 22.12.2024 um 10:12 Uhr

ShitzOvran
ShitzOvran 30.06.2009 um 10:03:35 Uhr
Goto Top
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
ShitzOvran
ShitzOvran 30.06.2009 um 10:53:19 Uhr
Goto Top
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
Eierbaer
Eierbaer 30.06.2009 um 21:35:12 Uhr
Goto Top
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
bastla
bastla 30.06.2009 um 23:49:31 Uhr
Goto Top
... 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