Abfrage, ob Verzeichnis da ist

20/07/2015 - 16:31 von Harald Friis | Report spam
Hallo in die Runde,

mit eurer Hilfe habe ich ein Makro zusammengeschustert, was ziemlich
genau das tut, was es soll: Ein Verzeichnis 'Ordner' und dann
Unterordner mit 'Name, Vorname' erstellen.

Weiter unten habe ich es in Gànze abgeschrieben.

Hierzu habe ich zwei Änderungen probiert, bin aber an der Ausführung
gescheitet:

1.) Derzeit wird zwingend ein Verzeichnis 'Ordner' erstellt. Ist dieses
schon vorhanden, bricht das Makro ab. Kann man da eine Abfrage einbauen,
ob das Verzeichnis schon vorhanden ist und ggf. dieses nehmen?

2.) Ich frage bewusst den Speicherort ab, da ich dieses Makro von einem
Stick ausführe. Kann man aber auch einstellen, dass dieses Verzeichnis
'Ordner' genau da erstellt wird, wo sich die Exceldatei befindet?

Danke für Hinweise.

Gruß

Harald Friis

Hier isses:

Sub Ordner()
Dim i As Integer
Dim sPfad As String
Dim AppShell As Object
Dim BrowseDir As Variant

' catch any errors
On Error GoTo ErrorHandling

' determine path
Set AppShell = CreateObject("Shell.Application")
Set BrowseDir = AppShell.BrowseForFolder(0, "Speicherort
auswàhlen", 0, 16)

If BrowseDir = "Desktop" Then
Path = CreateObject("WScript.Shell").SpecialFolders("Desktop")
Else
Path = BrowseDir.items().Item().Path
End If

If Path = "" Then GoTo ErrorHandling

Path = Path & "\Ordner" & "\"
MkDir Path

On Error GoTo ErrorHandling

For i = 2 To 16
sPfad = Cells(i, 3).Value & "_" & Cells(i, 4).Value
If Cells(i, 1) <> "" Then MkDir Path & sPfad
Next

ErrorHandling:
Application.Visible = True

If Err.Number = 76 Then
MsgBox "Der ausgewàhlte Speicherort ist ungültig", vbOKOnly +
vbCritical
ElseIf Err.Number = 4198 Then
MsgBox "Der ausgewàhlte Speicherort ist ungültig", vbOKOnly +
vbCritical
ElseIf Err.Number = 91 Then
MsgBox "Exportieren abgebrochen", vbOKOnly + vbExclamation
ElseIf Err.Number > 0 Then
MsgBox "Unbekannter Fehler: " & Err.Number & " - Bitte Makro
erneut ausführen.", vbOKOnly + vbCritical
Else
MsgBox "Ordner erfolgreich erstellt", vbOKOnly + vbInformation
End If

End Sub
 

Lesen sie die antworten

#1 Ulrich Möller
20/07/2015 - 17:36 | Warnen spam
Hallo Harald,

Am 20.07.2015 um 16:31 schrieb Harald Friis:
Hallo in die Runde,

mit eurer Hilfe habe ich ein Makro zusammengeschustert, was ziemlich
genau das tut, was es soll: Ein Verzeichnis 'Ordner' und dann
Unterordner mit 'Name, Vorname' erstellen.

Weiter unten habe ich es in Gànze abgeschrieben.

Hierzu habe ich zwei Änderungen probiert, bin aber an der Ausführung
gescheitet:

1.) Derzeit wird zwingend ein Verzeichnis 'Ordner' erstellt. Ist
dieses schon vorhanden, bricht das Makro ab. Kann man da eine Abfrage
einbauen, ob das Verzeichnis schon vorhanden ist und ggf. dieses nehmen?

2.) Ich frage bewusst den Speicherort ab, da ich dieses Makro von
einem Stick ausführe. Kann man aber auch einstellen, dass dieses
Verzeichnis 'Ordner' genau da erstellt wird, wo sich die Exceldatei
befindet?

Danke für Hinweise.

Gruß

Harald Friis

Hier isses:

Sub Ordner()
Dim i As Integer
Dim sPfad As String
Dim AppShell As Object
Dim BrowseDir As Variant

' catch any errors
On Error GoTo ErrorHandling

' determine path
Set AppShell = CreateObject("Shell.Application")
Set BrowseDir = AppShell.BrowseForFolder(0, "Speicherort
auswàhlen", 0, 16)

If BrowseDir = "Desktop" Then
Path = CreateObject("WScript.Shell").SpecialFolders("Desktop")
Else
Path = BrowseDir.items().Item().Path
End If

If Path = "" Then GoTo ErrorHandling

Path = Path & "\Ordner" & "\"
MkDir Path

On Error GoTo ErrorHandling

For i = 2 To 16
sPfad = Cells(i, 3).Value & "_" & Cells(i, 4).Value
If Cells(i, 1) <> "" Then MkDir Path & sPfad
Next

ErrorHandling:
Application.Visible = True

If Err.Number = 76 Then
MsgBox "Der ausgewàhlte Speicherort ist ungültig", vbOKOnly +
vbCritical
ElseIf Err.Number = 4198 Then
MsgBox "Der ausgewàhlte Speicherort ist ungültig", vbOKOnly +
vbCritical
ElseIf Err.Number = 91 Then
MsgBox "Exportieren abgebrochen", vbOKOnly + vbExclamation
ElseIf Err.Number > 0 Then
MsgBox "Unbekannter Fehler: " & Err.Number & " - Bitte Makro
erneut ausführen.", vbOKOnly + vbCritical
Else
MsgBox "Ordner erfolgreich erstellt", vbOKOnly + vbInformation
End If

End Sub



zu 1) mit dem FileSystemObject - Beispiel siehe:
https://technet.microsoft.com/en-us...98738.aspx
zu 2) mit "Application.ActiveWorkbook.Path" oder
"Application.ActiveWorkbook.FullName" den aktuellen Pfad abfragen

Ulrich

Ähnliche fragen