Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1512to1516
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro legt Unterverzeichnisse an

Makro legt Unterverzeichnisse an
20.09.2016 20:24:00
obelix-xxl
Hallo,
leider verfüge ich über keine Makrokenntnisse, daher wende ich mich an die erfahrenen Nutzer dieses Forums mit der Bitte um Unterstützung.
Beschreibung der Aufgabenstellung:
In einer Exceltabelle habe ich eine große Anzahl von Raum-Tabellen.
Im Makro möchte ich gerne abgefragt werden ab welchem Tabellenblatt (z.B. ab dem 10. Tabellenblatt) der Tabellenblattname ausgelesen werden soll.
Der Tabellenblattname steht in jedem dieser Tabellenblätter in Zelle D3.
Für jede dieser Raum-Tabellen soll ein Unterverzeichnis mit dem Inhalt aus D3 erstellt werden.
Da das Unterverzeichnis wechseln kann sollte der Pfad abgefragt werden.
Nach der Abfrage werden dann die einzelnen Unterverzeichnisse mit dem Namen aus D3 im abgefragten Pfad angelegt.
Nun soll noch das Raumtabellenblatt in das passende Unterverzeichnis kopiert werden. Ein Vergleich zwischen Zelle D3 im Tabellenblatt und dem Namen des Unterverzeichnisses ist erforderlich.
Der Speichername des Raumtabellenblattes weicht vom Namen in Zelle D3 ab, steht aber in Zelle AB3.
Beispiel Zelle D3: "Raum 100"
Abfrage: Pfad für Unterverzeichneisse: z.B: C:\Sammlung\
In diesem Pfad wird nun das Unterverzeichnis "Raum 100" angelegt. Alle Tabellenblätter mit dem Namen des Unterverzeichnisses (dieser steht im Tabellenblatt in D3, z.B. "Raum 100") werden mit dem Namen aus Zelle AB3 dort im Unterverzeichnis gespeichert.
In AB3 steht der Speichername, z.B: "Raum 100 - Rev.1.0 - 160920". Der Dateiname setzt sich aus verschiedenen Informationen die im Tabellenblatt stehen zusammen. Ein Beispiel wäre "Raum 100 - Rev.1.0 -160920.xlsx" .
Das ist sicher eine komplexe Aufgabe die ich hoffentlich verständlich beschrieben habe.
Rückfragen beantworte ich so schnell als möglich.
Erst einmal Danke, dass Ihr Euch dieser tricky Aufgabe widmet.
Vielleicht kann man die Aufgabe ja auch mit mehreren Makro einfacher lösen?
LG
obelix

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro legt Unterverzeichnisse an
21.09.2016 08:59:34
UweD
Hallo Obelix
schon ein Wildschwein gefrühstückt?
Sub Verzeichnis_erstellen()
    Dim Pfad As String, Verz As String, Datei As String
    Dim abSheet As Integer, i As Integer, Antwort As Integer
    
    Pfad = "C:\Sammlung\"
    abSheet = InputBox("Start ab Tabellen Nummer?", "Verzeichnisse erstellen", 2)
    For i = abSheet To Sheets.Count
        Verz = Sheets(i).Range("D3") & "\"
        Datei = Sheets(i).Range("AB3")
        If Datei = "" Then MsgBox "Fehler Dateiname in Tabelle " & Sheets(i).Name, vbExclamation: Exit Sub
        
        'Verzeichnis prüfen und anlegen 
        If Dir(Pfad & Verz, vbDirectory) = "" Then
            MkDir (Pfad & Verz)
            'MsgBox "Ordner wurde angelegt!" 
        Else
            Antwort = MsgBox("Ordner '" & Pfad & Verz & "' ist vorhanden!" & vbLf & vbLf _
                & "Weiter?", vbExclamation + vbOKCancel)
            If Not Antwort = vbOK Then Exit Sub
        End If
        
        'Tabellenblatt in neue Datei 
        Sheets(i).Copy
        ActiveWorkbook.SaveAs Filename:=Pfad & Verz & Datei & ".xlsx", _
            FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        ActiveWorkbook.Close
    Next
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 15 - mit VBAHTML 12.6.0

kann sicherlich noch weiter ausgebaut werden
Gruß UweD
Anzeige
AW: Makro legt Unterverzeichnisse an
21.09.2016 11:36:05
obelix-xxl
Hallo UweD,
nein ein Wildschwein habe ich noch nicht gefrühstückt. Das kommt evtl zum Mittag auf den Tisch :)
Deine Lösung habe ich jetzt ausgiebig getestet. Das Makro läuft genau so wie ich meinen Wunsch beschrieben habe. Klasse!!!
Wie kann ich eine Abfrage nach dem Pfad in den die Tabellenblätter gespeichert werden sollen einbinden?
Als Alternative könnte ich jedoch auf die Vorgabe der anzulegenden Verzeichnisse verzichten, da die Dateien auch direkt in den Pfad gelegt werden können. Kann ich dann einfach den Syntax ändern?
ActiveWorkbook.SaveAs Filename:=Pfad & Verz & Datei & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
in dem ich Verz & lösche?
LG
obelix
Anzeige
AW: Makro legt Unterverzeichnisse an
21.09.2016 12:08:48
UweD
Hallo nochmal
so?
Sub Verzeichnis_erstellen()
    Dim Pfad As String, Verz As String, Datei As String
    Dim abSheet As Integer, i As Integer, Antwort As Integer
    Dim Dlg As FileDialog
    
    Set Dlg = Application.FileDialog(msoFileDialogFolderPicker) 'Verzeichnis wählen 
    Dlg.InitialFileName = ThisWorkbook.Path
    If Not Dlg.Show Then Exit Sub 'wenn nichts gewählt wurde 
    Pfad = Dlg.SelectedItems(1)
    
    abSheet = InputBox("Start ab Tabellen Nummer?", "Verzeichnisse erstellen", 2)
    For i = abSheet To Sheets.Count
        Verz = Sheets(i).Range("D3") & "\"
        Datei = Sheets(i).Range("AB3")
        If Datei = "" Then MsgBox "Fehler Dateiname in Tabelle " & Sheets(i).Name, vbExclamation: Exit Sub
        
        'Verzeichnis prüfen und anlegen 
        If Dir(Pfad & Verz, vbDirectory) = "" Then
            MkDir (Pfad & Verz)
            'MsgBox "Ordner wurde angelegt!" 
        Else
            Antwort = MsgBox("Ordner '" & Pfad & Verz & "' ist vorhanden!" & vbLf & vbLf _
                & "Weiter?", vbExclamation + vbOKCancel)
            If Not Antwort = vbOK Then Exit Sub
        End If
        
        'Tabellenblatt in neue Datei 
        Sheets(i).Copy
        ActiveWorkbook.SaveAs Filename:=Pfad & Verz & Datei & ".xlsx", _
            FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        ActiveWorkbook.Close
    Next
End Sub

LG UweD
Anzeige
AW: Makro legt Unterverzeichnisse an
21.09.2016 14:16:06
obelix-xxl
Hallo UweD,
die zweite Version habe ich getestet. Diese hat noch einen Fehler. Dieser ist mir erst eben aufgefallen.
Bei der Abfrage "Start der Tabellennummer?" gebe ich die korrekte Ziffer ein. Ab dieser wird auch fleißig gearbeitet.
Danach wird der Pfad abgefragt. Es kommt dann aber eine Fehlermeldung. Es wird nur ein Teil des Pfades erkannt? Liegt das an der Definition des Pfades als String?
Mein Pfad ist ggf. auch viel zu lang. Bei der Abfrage erscheint im Fenster der richtige Pfad, im unten stehenden Bereich kann der Ordner abgelesen werden. Dort steht nicht der komplette Pfad, sondern nur ein Teil des Pfades.
Der Pfad endet mit "Raumliste technisch - Ab". Im Ordnerfenster steht jedoch nur "technisch - Ab" .
Der vorher neu angelegte Ordner wird nicht übernommen.
Anstelle vom gewünschten und neu angelegten Verzeichnis "URS Raum" werden die Verzeichnisse und Dateien so eine Ebene höher im Verzeichnisbaum abgelegt. Der Name des Unterverzeichnisses ist dann so: "URS RaumH0-01-101". Er sollte jedoch so aussehen: "H0-01-101". URS Raum ist das "Wunschverzeichnis in dem dann das Unterverzeichnis "H0-01-101" angelegt werden sollte.
Ich kann nicht beurteilen wo der Hund begraben ist. Vielleicht ist das auch nur ein Syntaxfehler? ?
LG
Obelix
Anzeige
AW: Makro legt Unterverzeichnisse an
21.09.2016 14:45:37
UweD
Hallo
ich hab mal noch einige Msgboxen eingebaut.
An der Stringlänge kann es nicht liegen:
Zitat aus der MS-Hilfe
• Eine Zeichenfolge mit variabler Länge kann bis zu ca. 2 Milliarden (2^31) Zeichen enthalten.
Welche Fehlermeldung kommt denn?
Ich hatte eine ganz bewusst eingebaut, die aufpoppt, wenn der Dateiname in einem Blatt (AB3) leer ist
Sub Verzeichnis_erstellen()
    Dim Pfad As String, Verz As String, Datei As String
    Dim abSheet As Integer, i As Integer, Antwort As Integer
    Dim Dlg As FileDialog
    
    Set Dlg = Application.FileDialog(msoFileDialogFolderPicker) 'Verzeichnis wählen 
    Dlg.InitialFileName = ThisWorkbook.Path
    If Not Dlg.Show Then Exit Sub 'wenn nichts gewählt wurde 
    Pfad = Dlg.SelectedItems(1)
    MsgBox "Länge Pfad=" & Len(Pfad)
    abSheet = InputBox("Start ab Tabellen Nummer?", "Verzeichnisse erstellen", 2)
    For i = abSheet To Sheets.Count
        Verz = Sheets(i).Range("D3") & "\"
        MsgBox "Verzeichnis aus Zelle D3 ="
        Datei = Sheets(i).Range("AB3")
        MsgBox "Dateiname aus AB3 ="
        If Datei = "" Then MsgBox "Fehler: Kein Dateiname im Blatt: " & Sheets(i).Name, vbExclamation: Exit Sub
        
        'Verzeichnis prüfen und anlegen 
        If Dir(Pfad & Verz, vbDirectory) = "" Then
            MkDir (Pfad & Verz)
            'MsgBox "Ordner wurde angelegt!" 
        Else
            Antwort = MsgBox("Ordner '" & Pfad & Verz & "' ist vorhanden!" & vbLf & vbLf _
                & "Weiter?", vbExclamation + vbOKCancel)
            If Not Antwort = vbOK Then Exit Sub
        End If
        
        'Tabellenblatt in neue Datei 
        Sheets(i).Copy
        ActiveWorkbook.SaveAs Filename:=Pfad & Verz & Datei & ".xlsx", _
            FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        ActiveWorkbook.Close
    Next
End Sub
LG UweD
Anzeige
AW: Makro legt Unterverzeichnisse an
21.09.2016 15:34:03
obelix-xxl
Hallo UweD,
die Abfragen funktionieren so ohne Störung.
MTest ist das Verzeichnis in das die Unterverzeichnisse erstellt werden sollen.
MTest ist angelegt, und die Verzeichnisse werden so erstellt.
So erscheint der Bildschirminhalt:
MTest
MTestH0-00-544
MTestH0-00-545
MTestH0-00-546

In den Verzeichnissen MTestH0-00-... sind auch die passenden Dateien abgelegt. Das ist so wunschgemäß.
Die Verzeichnisse sollten jedoch so benannt sein:
"Oberverzeichnis": MTest
Unterverzeichnis : H0-00-544 hier ist die passenden Datei abgelegt. Das klappt.
Unterverzeichnis : H0-00-545 hier ist die passenden Datei abgelegt. Das klappt.
Unterverzeichnis : H0-00-546 hier ist die passenden Datei abgelegt. Das klappt.
Kannst Du die Darstellung der Verzeichnisse so nachvollziehen?
Da ist vielleicht eine Verknüpfung im Makro nicht passend?
LG
obelix
Anzeige
AW: Makro legt Unterverzeichnisse an
21.09.2016 19:47:28
obelix-xxl
Hallo UweD,
ich habe soeben das Makro auf einem anderen Rechner laufen lassen. Es läuft fehlerfrei!
Noch weis ich nicht warum auf dem anderen Rechner das Problem mit dem Pfad/Unterverzeichnis auftritt. Ich melde mich jedoch morgen noch einmal und berichte.
Bitte jetzt keine weiteren Anstrengungen mehr.
Nochmals tausend mal DANKE!
LG
obelix
AW: Makro legt Unterverzeichnisse an
25.09.2016 10:05:00
obelix-xxl
Hallo UweD,
den Fehler scheine ich gefunden zu haben.
Die Dateipfade und Unterverzeichnisse haben in der Bezeichnung auch Sonderzeichen gehabt.
Das konnte nicht gut gehen. Die Sonderzeichen sind alle entfernt und zusätzlich auch die Bezeichnungen deutlich gekürzt worden.
Jetzt dürften alle Fehlerquellen ausgeschlossen sein.
Nochmals 1000 Dank für Deine Unterstützung.
LG
obelix
Anzeige
Prima! Danke für die Rückmeldung.
26.09.2016 08:42:26
UweD

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige