Verzeichnis anlegen u. speichern

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" _ (ByVal PFAD As String) As Long Sub test() Dim strVz As String strVz = Cells(17, 1) & ":\" & Join(Application.Transpose(Range("A18:A20")), "\") If Right(strVz, 1) "\" Then strVz = strVz & "\" ' MsgBox strVz ' MsgBox MakeSureDirectoryPathExists(strVz) If MakeSureDirectoryPathExists(strVz) Then ActiveWorkbook.SaveAs strVz & Cells(32, 1) & ".xls" Else MsgBox "Dieses Verzeichnis konnte nicht angelegt werden:" & vbLf & strVz End If End Sub

Hi Kurt,
nach deinen neuen Wünschen würde man das Ganze anders aufbauen.
Was meinst du mit "noch ein Unter-Verzeichnis"?
Das jetzige Makro verträgt Verzeichnisnamen in A18:A19 oder A18:A20, also zwei oder drei Ordner.
Könnten es auch vier sein, also bis A21?
Wie auch immer, wenn es auch nur 1 Ordner sein kann, würde man das wohl doch in einer Schleife abarbeiten,
das ginge dann auch mit MkDir().
Auch dein zweiter Wunsch geht in Richtung "Verzicht auf MakeSureDirectoryPathExists",
denn diese Funktion liefert nicht, ob ein Verzeichnis (oder mehrere) neu angelegt wurde.
Ich habe jetzt keine Zeit, aber du kannst ja schon mal im Archiv nach MkDir suchen,
da findest du sicher etliche Makros.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Hi Kurt und guten Morgen,
hier habe ich doch noch eine neue Version für dich:


Option Explicit
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" _
(ByVal PFAD As String) As Long
Sub test2()
Dim strVz As String, zz As Long, strAV As String, strNV As String
zz = 17
strVz = Cells(zz, 1) & ":\"
If Dir(strVz, vbDirectory) = "" Then
MsgBox "Laufwerk falsch:" & vbLf & strVz, vbCritical
Exit Sub
End If
strAV = strVz
While Not IsEmpty(Cells(zz + 1, 1)) And zz  "" Then
strAV = "Schon vorhanden war Verzeichnis:" & vbLf & strVz
Else
If MakeSureDirectoryPathExists(strVz)  1 Then
MsgBox "Nicht angelegt werden konnte Verzeichnis:" & vbLf & strVz, vbCritical
Exit Sub
ElseIf strNV = "" Then
strNV = _
"Neu angelegt wurde (evtl. mit Unterverzeichnissen)" & vbLf & strVz
End If
End If
Wend
MsgBox strAV & strNV, vbInformation
ActiveWorkbook.SaveAs strVz & Cells(32, 1) & ".xls"
End Sub

Klappt es so, wie du es möchtest?
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Beliebteste Forumthreads (12 Monate)

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread