Microsoft Excel

Herbers Excel/VBA-Archiv

Ordner anlegen


Betrifft: Ordner anlegen von: Marc
Geschrieben am: 10.04.2017 11:13:19

Moin, ich habe bereitsüber dieses Forum eine super Excel-Funktion erstellen können.
Dafür habe ich mir folgenden Code "geklaut":

Option Explicit

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

Sub SpeichernUnter()
Dim strFilePath As String
Dim strExt As String, lngFormat As Long

Const cstrStdPath = "Y:\Melktechnik\Kunden\"

getFileExtAndFormat ThisWorkbook, strExt, lngFormat

With ThisWorkbook
With .Worksheets("Hilfstabelle")
strFilePath = cstrStdPath & IIf(Right(cstrStdPath, 1) = "\", "", "\") & _
.Range("B2") & IIf(Right(.Range("B2"), 1) = "\", "", "\") & _
.Range("B5") & IIf(Right(.Range("B5"), 1) = "\", "", "\") & _
.Range("B6") & IIf(Right(.Range("B6"), 1) = "\", "", "\") & .Range("B1") & .Range("B2") & strExt
End With

If MakeSureDirectoryPathExists(strFilePath) <> 0 Then .SaveAs strFilePath, lngFormat
End With

End Sub

Private Function getFileExtAndFormat(ByRef WB As Workbook, ByRef strExt As String, ByRef  _
lngFormat As Long)
  With WB
    If Val(Application.Version) < 12 Then
      strExt = ".xls": lngFormat = -4143
    Else
      Select Case WB.FileFormat
        Case 51: strExt = ".xlsx": lngFormat = 51
        Case 52:
          If .HasVBProject Then
            strExt = ".xlsm": lngFormat = 52
          Else
            strExt = ".xlsx": lngFormat = 51
          End If
        Case 56: strExt = ".xls": lngFormat = 56
        Case Else: strExt = ".xlsb": lngFormat = 50
      End Select
    End If
  End With
End Function


Es wird unter Y:\Melktechnik\Kunden\ nun noch ein Kundenordner mit Kundenname und Kundennummer (Info kommt aus Zelle B2) erstellt, darin ein Ordner Auftragsnummer (Info kommt aus Zelle B5) und darin ein Ordner "Aufträge" mit der Datei gespeichert.
Soweit alles Prima.
Nun stellt sich folgende Aufgabe:
- ich möchte im Ordner, der aus Zelle B5 erstellt wird nicht nur den Ordner Aufträge erstellen, sondern zusätzlich weitere Ordner einfügen, bspw. Bilder, Schriftverkehr, Protokolle, etc. ohne, dass darin eine Datei gespeichert wird.
Ist das Möglich?
MfG Marc

  

Betrifft: AW: Ordner anlegen von: UweD
Geschrieben am: 10.04.2017 11:34:11

Hallo


der Befehl wäre MKDIR()

    cstrStdPath = "Y:\Melktechnik\Kunden\"
    MkDir (cstrStdPath & "Neu")

Kannst du selbst einbauen...



LG UweD


  

Betrifft: AW: Ordner anlegen von: Marc
Geschrieben am: 10.04.2017 11:51:08

Hallo UweD,

vielen Dank für die schnelle Antwort.
Wo genau muss ich den Befehl einbauen?
Ich habe mehrere Versionen ausprobiert, aber ich bekomme nur Fehler.
Vielen Dank für die Unterstützung.

VG Marc


  

Betrifft: AW: Ordner anlegen von: UweD
Geschrieben am: 10.04.2017 12:52:36

Hallo nochmal


ohne Musterdatei immer schwierig zu testen.

Ich denke nach ....B5 sollen die neuen Ordner angelegt werden oder?
Ich habe den Gesamtpfad in 2 Teile ausgespalten...


Sub SpeichernUnter()
    Dim strFilePath1 As String
    Dim strFilePath2 As String
    Dim strExt As String, lngFormat As Long
    
    Const cstrStdPath = "Y:\Melktechnik\Kunden\"
    'Const cstrStdPath = "C:\temp\" 
    
    getFileExtAndFormat ThisWorkbook, strExt, lngFormat
    
    With ThisWorkbook
        With .Worksheets("Hilfstabelle")
            strFilePath1 = cstrStdPath & IIf(Right(cstrStdPath, 1) = "\", "", "\") & _
            .Range("B2") & IIf(Right(.Range("B2"), 1) = "\", "", "\") & _
            .Range("B5") & IIf(Right(.Range("B5"), 1) = "\", "", "\")
            
            strFilePath2 = strFilePath1 & .Range("B6") & IIf(Right(.Range("B6"), 1) = "\", "", "\") _
            & .Range("B1") & .Range("B2") & strExt
            MkDir (strFilePath1 & "Bilder")
            MkDir (strFilePath1 & "Schriftverkehr")
            MkDir (strFilePath1 & "Protokolle")
            '..usw. 
        End With
    
        If MakeSureDirectoryPathExists(strFilePath2) <> 0 Then .SaveAs strFilePath2, lngFormat
    End With

End Sub

LG UweD


  

Betrifft: AW: Ordner anlegen von: Marc
Geschrieben am: 10.04.2017 13:49:31

Hallo nochmal,
vielen Dank, ich habe das ganze nochmals getestet.
Der Ordner, welchen ich aus Zelle B5 erstelle muss bereits vorhanden sein, sonst können die Unterordner nicht erstellt werden.
Heißt für mich aktuell:
ich spiele erst mein Original-Makro ab und anschließend nochmals dein überarbeitetes Makro. Dann werden die Unterordner erstellt.
Vielen Dank für die Lösung!


Beiträge aus den Excel-Beispielen zum Thema "Ordner anlegen"