Ordner per Makro anlegen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Jaqueline,
teste mal, ob der u.a. Code in Deinem Sinne funktioniert.
Für die Pfadabfrage habe ich einen Dialog gewählt. Da kann man natürlich auch eine Inputbox nehmen, wenn es Dir lieber ist.

Option Explicit

Sub OrdnerAnlegen()

 Dim sOrdner As String, sPfad As String

' sPfad = "$E$2"            'Pfad ohne Auswahl vorgeben, ausremmen und anpassen!!!

 On Error GoTo Fehler

 If sPfad = "" Then         'Pfad per Dialog auswählen

  With Application.FileDialog(msoFileDialogFolderPicker)

      .AllowMultiSelect = False

      .title = "Bitte den gewünschten Pfad auswählen!"

      .InitialFileName = ""

      .InitialView = msoFileDialogViewThumbnail

      .ButtonName = "Auswählen"

      If Not .Show = -1 Then Exit Sub

      sPfad = .SelectedItems(1)

  End With

 ElseIf sPfad Like "$*#" Then

  sPfad = Range(sPfad).value

 Else

 End If

 ChDir sPfad                'Pfad einstellen

'Jetzt neuen Ordner ermitteln und erstellen

 sOrdner = InputBox("Bitte den Namen des neuen Ordners angeben!", "Ordner anlegen")

 If StrPtr(sOrdner) = 0 Then Exit Sub

 If sOrdner Like "$*#" Then sOrdner = Range(sOrdner).value

 MkDir sOrdner

 MsgBox "Der Ordner " & sOrdner & " wurde angelegt", vbInformation, "Ordner erstellen"

 Exit Sub

Fehler:

 MsgBox "Es ist der Fehler " & Err & ", " & Error & " aufgetreten", vbCritical, "Ordner erstellen"

End Sub

viele Grüße
Karl-Heinz

Hallo
folgendes Vorgehen...
- Doppelclick auf eine Zelle mit der Ordnerangabe
- Prüfung ob in dem gewählten Bereich
- Öffnen der Ordnerauswahl (wie von Karl Heinz beschrieben)
- nach der Auswahl wird der Wert aus der Zelle als Unterordner verwendet.
Microsoft Excel Objekt Tabelle1

Option Explicit 
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 
    On Error GoTo Fehler 
    Dim RNG As Range 
    Dim sOrdner As String, sPfad As String 
     
    Set RNG = Union(Range("A1:A10"), Range("C20:C25")) ' als Beispiel für Zellen mit Ordnerangaben 
     
    If Not Intersect(Target, RNG) Is Nothing Then 
        Cancel = True 
        If Target <> "" Then 
         
            With Application.FileDialog(msoFileDialogFolderPicker) 
                  .AllowMultiSelect = False 
                  .Title = "Bitte den gewünschten Pfad auswählen!" 
                  .InitialFileName = "" 
                  .InitialView = msoFileDialogViewThumbnail 
                  .ButtonName = "Auswählen" 
                  If Not .Show = -1 Then Exit Sub 
                  sPfad = .SelectedItems(1) 
            End With 
             
            sOrdner = sPfad & "\" & Target.Value 
            MkDir sOrdner 
             
            MsgBox "Der Ordner " & sOrdner & " wurde angelegt", vbInformation, "Ordner erstellen" 
        End If 
 
    End If 
     
    Exit Sub 
Fehler: 
    MsgBox "Es ist der Fehler " & Err & ", " & Error & " aufgetreten", vbCritical, "Ordner erstellen" 
End Sub

Der Code MUSS in den Bereich der Tabelle:
- Rechtsclick auf den Tagellenblattreiter
- Code anzeigen
- In das rechte Fenster kopieren
LG UweD

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Ordner per Makro anlegen

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread