Vezeichnis erstellen

Forumthread: Vezeichnis erstellen

12.08.2017 12:17:59

Michael

Hallo,
ich bin noch Anfänger in der vba-Nutzung und komme bei dem Versuch nicht weiter, ein Verzeichnis erstellen zu lassen.
Ich möchte in dem Verzeichnis, in dem die Arbeitsmappe abgespeichert ist, ein Unterverzeichnis erstellen, das den Namen der Arbeitsmappe erhält.
Es erscheint die Fehlermeldung 75: Fehler beim Zugriff auf Pfad/Datei.
Ich habe folgenden Code verwendet:

Sub Pfadauslesen()
Dim strPfad, strAname, strPname As String
strPfad = ActiveWorkbook.Path
strAname = ActiveWorkbook.Name
strPname = Environ("USERPROFILE")
MsgBox ("ActiveWorkbook.path: " & strPfad)
MsgBox ("ActiveWorkbook.Name: " & strAname)
MsgBox ("Environ (Userprofile):" & strPname)
MsgBox ("Speicherpfad:" & vbLf & strPfad & "\" & strAname)
MsgBox ("Verzeichnis erstellen:" & strPfad & "\" & strAname)
MkDir (strPfad & "\" & strAname)
'MkDir ("TESTTEST")
End Sub

Kann mir jemand weiterhelfen? Danke im Voraus.
Michael

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Vezeichnis erstellen

12.08.2017 12:32:39

Sepp
Korrektur!

12.08.2017 13:18:32

Sepp
AW: Korrektur!

13.08.2017 22:48:49

Michael
AW: Korrektur!

14.08.2017 06:35:54

Sepp

AW: Vezeichnis erstellen

12.08.2017 12:32:39

Sepp

Hallo Michael,

' **********************************************************************
' Modul: Modul2  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

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

Sub createDirctory()
Dim strPath As String, strName As String


strName = ThisWorkbook.Name
strName = Left(strName, InStrRev(strName, ".") - 1)
strPath = ThisWorkbook.Path & "\" & strName

If MakeSureDirectoryPathExists(strPath) <> 0 Then
  MsgBox "Verzeichnis " & strPath & " erstellt!"
End If
End Sub

Gruß Sepp

Korrektur!

12.08.2017 13:18:32

Sepp

Hallo Micheal,
hatte den "\" am Ende vergessen.

' **********************************************************************
' Modul: Modul2  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

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

Sub createDirctory()
Dim strPath As String, strName As String


strName = ThisWorkbook.Name
strName = Left(strName, InStrRev(strName, ".") - 1)
strPath = ThisWorkbook.Path & "\" & strName & "\"

If MakeSureDirectoryPathExists(strPath) <> 0 Then
  MsgBox "Verzeichnis " & strPath & " erstellt!"
End If
End Sub

Gruß Sepp

AW: Korrektur!

13.08.2017 22:48:49

Michael

Hallo Sepp,
vielen Dank für den Code. Zwar verstehe ich ihn nicht vollständig, aber er funktioniert und erstellt das gewünschte Unterverzeichnis. Er kürzt sogar noch die Dateierweiterung.
Allerdings erscheint die Messagebox auch, wenn das Verzeichnis bereits existiert. Mal sehen, ob ich das selber hinbekomme.
Jetzt muss ich mir nur noch weitere Informationen anlesen, um den Code vollständig zu verstehen. Es handelt sich dabei um die Zeile
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
Gruss
Michael

AW: Korrektur!

14.08.2017 06:35:54

Sepp

Hallo Michael,
MakeSureDirectoryPathExists ist eine Windows-API-Funktion, sie erstellt einen kompletten Verzeichnispfad.
Prüfen ob ein Verzeichnis schon besteht, kannst du z.B. so.

' **********************************************************************
' Modul: Modul4  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

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

Sub createDirctory()
Dim strPath As String, strName As String


strName = ThisWorkbook.Name
strName = Left(strName, InStrRev(strName, ".") - 1)
strPath = ThisWorkbook.Path & "\" & strName & "\"

If Dir(strPath, vbDirectory) = "" Then
  If MakeSureDirectoryPathExists(strPath) <> 0 Then
    MsgBox "Verzeichnis " & strPath & " erstellt!"
  End If
End If

End Sub

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

Forumthread: Vezeichnis erstellen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread