FSO.CreateFolder

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: FSO.CreateFolder
von: Henry
Geschrieben am: 22.09.2015 16:50:03

Moin Zusammen,
schienbar stehe ich auf dem Schlauch und bitte um Hilfe :)
Ich speichere einen Outlook Ordner mittels VBA auf die Festplatte und habe dafür einen VBA im Netz gefunden. Benutzt wird der Befehl FSO.CreateFolder (Name/Pfad)
wenn es keinen Ordner gibt der den Namen hat.
ich bekomme jedoch eine Fehlermeldung Path does not exist.
Also es handelt sich um einen Ordner aus dem Posteingang + Unterordner
Sprich der Name ist Posteingang\UnterordnerA
Beim Dialog zum speichern selektiere ich das Laufwerk H:\OrdnerB
Fehlermeldung Path does not exist
Wenn ich den Ordner Posteingang in "H:\OrdnerB\Posteingang" schon vorab erstelle läuft der Code und speichert den UnterordnerA dort.
Gibt es hierzu eine alternative, so dass er den Ordner Posteingang + UnterordnerA erstellt ohne vorher den Posteingang als Ornder anzulegen ???

For i = 1 To Folders.Count
        StrFolder = StripIllegalChar(Folders(i))
        n = InStr(3, StrFolder, "\") + 1
        StrFolder = Mid(StrFolder, n, 256)
        StrFolderPath = StrSavePath & StrFolder & "\"
        StrSaveFolder = Left(StrFolderPath, Len(StrFolderPath) - 1) & "\"
        If Not FSO.FolderExists(StrFolderPath) Then
            FSO.CreateFolder (StrFolderPath)
        End If
        Set SubFolder = myOlApp.Session.GetFolderFromID(EntryID(i), StoreID(i))
        On Error Resume Next



Bild

Betrifft: AW: FSO.CreateFolder
von: Daniel
Geschrieben am: 22.09.2015 17:02:06
Hi
Google mal nach
MakeSureDirectoryPathExists
ist ne API-Funktion, dh erklären kann ich dir es nicht.
damit kann man aber die Verzeichnisstruktur direkt erstellen, ohne jeden einzelnen Unterordner erstellen zu müssen.
Gruß Daniel

Bild

Betrifft: AW: FSO.CreateFolder
von: Henry
Geschrieben am: 22.09.2015 17:31:12
Hi Daniel,
danke, ich werd mir das denke ich ganz in Ruhe mal anschauen.
Leider konnte ich das auf anhieb nicht einbinden bzw ersetzen.
Jemand schon ne Lösung für mich damit ich in Ruhe schlafen kann ?

Bild

Betrifft: AW: FSO.CreateFolder
von: Michael
Geschrieben am: 22.09.2015 18:42:49
Hi zusammen,
die API-Funktion wurde hier von Sepp erklärt:
https://www.herber.de/forum/archiv/708to712/708450_Ordner_erstellen_mit_VBA_Code_anpassen.html
Zum Spielen kopiere Dir bitte mal das in ein Modul:

'API Deklaration~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
  ByVal DirPath As String) As Long
'Ende API Deklaration~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Sub DirTestSepp()
Dim ordner$
Dim i&
ordner = Range("A2").Value       ' hier gibst Du testweise Pfade ein
If Right(ordner, 1) <> "\" Then ordner = ordner & "\"
i = MakeSureDirectoryPathExists(ordner)
If i <> 0 Then
  MsgBox "Pfad existiert spätestens jetzt, ab hier beliebige Aktion"
Else
  MsgBox "Pfad konnte nicht erstellt werden!", 48, "Hinweis"
End If
End Sub
Sub OderDirTest() ' Variante mit Zwischenergebnissen im Debug-Fenster
Dim ordner$, test$, ergebnis$
Dim i&
Dim oa
ordner = Range("A2").Value       ' hier gibst Du testweise Pfade ein
oa = Split(ordner, "\")
For i = 0 To UBound(oa): Debug.Print i & ": " & oa(i): Next
'Stop
test = oa(0) & "\"
For i = 1 To UBound(oa)
  test = test & oa(i)
  ergebnis = Dir(test, vbDirectory)
  Debug.Print i & ": " & ergebnis
  If ergebnis = "" Then MkDir test
  If i < UBound(oa) Then test = test & "\"
Next
End Sub
Die obere Funktion ist die Variante von Sepp, die untere ist nicht ganz ausgereift, weil sie nicht zwischen Ordnern und Dateinamen unterscheidet, aber Du kannst im Debug-Fenster bzw. beim Durchgehen des Codes mit F8 schrittweise nachvollziehen, was passiert.
Das alles in Deinen Code einzubauen scheitert daran, daß wir ja nicht wissen, was wann in welchen Deiner Variablen steht.
Die zweite Zeile verstehe ich ohnehin nicht: zuerst schneidest Du das letzte Zeichen ab, das ja wegen der Zeile vorher bekanntlich ein \ ist, und dann hängst Du wieder ein \ an.
StrFolderPath = StrSavePath & StrFolder & "\"
StrSaveFolder = Left(StrFolderPath, Len(StrFolderPath) - 1) & "\"
Schöne Grüße,
Michael

Bild

Betrifft: AW: FSO.CreateFolder
von: Daniel
Geschrieben am: 22.09.2015 19:01:24
Hi
wenn du dich nicht mit den Tiefen des Betriebssystems auseinandersezten willst, dann kann man sich auch eine kleine Funktion schreiben, die das erledigt:

Sub PfadErstellen(Pfad As String)
Dim PfadTeile
Dim Pfad1
Dim i As Long
PfadTeile = Split(Pfad, "\")
Pfad1 = PfadTeile(0)
For i = 1 To UBound(PfadTeile)
    Pfad1 = Pfad1 & "\" & PfadTeile(i)
    If Dir(Pfad1, vbDirectory) = "" Then MkDir Pfad1
Next
End Sub
diesen Code in ein allgemeines Modul und bei Bedarf einfach aufrufen mit
Call PfadErstellen("C:\Ordern1\Ordner2\Ordner3")
Gruß Daniel

Bild

Betrifft: AW: FSO.CreateFolder
von: Henry
Geschrieben am: 23.09.2015 09:37:09
Guten Morgen Daniel,
besten Dank für deine Mühe!!!
Anbei mal der ganze Code. Es gehthier speziell um den Teil ab For I.
Könnte man den Teil direkt dort einbauen ? FSO.CreateFolder durch den Call zu ersetzen funktionierte leider nicht. Erstellt werden soll Ordner + Unterordner in einem ausgewählten Laufwerk per Dialog

Option Explicit
Public lf As New LogFile
 
Sub SaveAllEmails_ProcessAllSubFolders()
    Dim i               As Long
    Dim j               As Long
    Dim n               As Long
    Dim StrSubject      As String
    Dim StrName         As String
    Dim StrFile         As String
    Dim StrReceived     As String
    Dim StrSavePath     As String
    Dim StrFolder       As String
    Dim StrFolderPath   As String
    Dim StrSaveFolder   As String
    Dim Prompt          As String
    Dim Title           As String
    Dim iNameSpace      As NameSpace
    Dim myOlApp         As Outlook.Application
    Dim SubFolder       As MAPIFolder
    Dim mItem           As MailItem
    Dim FSO             As Object
    Dim ChosenFolder    As Object
    Dim Folders         As New Collection
    Dim EntryID         As New Collection
    Dim StoreID         As New Collection
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set myOlApp = Outlook.Application
    Set iNameSpace = myOlApp.GetNamespace("MAPI")
    Set ChosenFolder = iNameSpace.PickFolder
    If ChosenFolder Is Nothing Then
GoTo ExitSub:
    End If
    Prompt = "Please enter the path to save all the emails to."
    Title = "Folder Specification"
    StrSavePath = BrowseForFolder
    If StrSavePath = "" Then
GoTo ExitSub:
    End If
    If Not Right(StrSavePath, 1) = "\" Then
        StrSavePath = StrSavePath & "\"
    End If
    lf.name = StrSavePath + "Post.log"
    Call GetFolder(Folders, EntryID, StoreID, ChosenFolder)
     
    For i = 1 To Folders.Count
        StrFolder = StripIllegalChar(Folders(i))
        n = InStr(3, StrFolder, "\") + 1
        StrFolder = Mid(StrFolder, n, 256)
        StrFolderPath = StrSavePath & StrFolder & "\"
        StrSaveFolder = Left(StrFolderPath, Len(StrFolderPath) - 1) & "\"
        If Not FSO.FolderExists(StrFolderPath) Then
            FSO.CreateFolder (StrFolderPath)
        End If
        Set SubFolder = myOlApp.Session.GetFolderFromID(EntryID(i), StoreID(i))
        On Error Resume Next
        For j = 1 To SubFolder.Items.Count
            Set mItem = SubFolder.Items(j)
'            StrReceived = ArrangedDate(mItem.ReceivedTime)
            StrReceived = Format(mItem.ReceivedTime, "yyyy-mm-dd_hh-nn-ss")
            StrSubject = mItem.Subject
            StrName = StripIllegalChar(StrSubject)
            StrFile = StrSaveFolder & StrReceived & "_" & StrName
            StrFile = Left(StrFile, 200) & ".msg"
            lf.LFInfo StrReceived & "<|>" & StrName & "<|>" & mItem.Sender.name & "<|>" & mItem. _
To & "<|>" & mItem.CC & "<|>" & StrFile
            mItem.SaveAs StrFile, 3
        Next j
        On Error GoTo 0
    Next i
ExitSub:
End Sub
 
Function StripIllegalChar(StrInput)
    Dim RegX            As Object
    Set RegX = CreateObject("vbscript.regexp")
    RegX.Pattern = "[\" & Chr(34) & Chr(10) & Chr(13) & "\!\@\#\$\%\^\&\*\(\)\=\+\|\[\]\{\}\`\'\ _
;\:\<\>\?\/\,]"
    RegX.IgnoreCase = True
    RegX.Global = True
    StripIllegalChar = RegX.Replace(StrInput, "")
ExitFunction:
    Set RegX = Nothing
End Function
 
Function ArrangedDate(StrDateInput)
    Dim StrFullDate     As String
    Dim StrFullTime     As String
    Dim StrAMPM         As String
    Dim StrTime         As String
    Dim StrYear         As String
    Dim StrMonthDay     As String
    Dim StrMonth        As String
    Dim StrDay          As String
    Dim StrDate         As String
    Dim StrDateTime     As String
    Dim RegX            As Object
    Set RegX = CreateObject("vbscript.regexp")
    If Not Left(StrDateInput, 2) = "10" And _
    Not Left(StrDateInput, 2) = "11" And _
    Not Left(StrDateInput, 2) = "12" Then
        StrDateInput = "0" & StrDateInput
    End If
    StrFullDate = Left(StrDateInput, 10)
    If Right(StrFullDate, 1) = " " Then
        StrFullDate = Left(StrDateInput, 9)
    End If
    StrFullTime = Replace(StrDateInput, StrFullDate & " ", "")
    If Len(StrFullTime) = 10 Then
        StrFullTime = "0" & StrFullTime
    End If
    StrAMPM = Right(StrFullTime, 2)
    StrTime = StrAMPM & "-" & Left(StrFullTime, 8)
    StrYear = Right(StrFullDate, 4)
    StrMonthDay = Replace(StrFullDate, "/" & StrYear, "")
    StrMonth = Left(StrMonthDay, 2)
    StrDay = Right(StrMonthDay, Len(StrMonthDay) - 3)
    If Len(StrDay) = 1 Then
        StrDay = "0" & StrDay
    End If
    StrDate = StrYear & "-" & StrMonth & "-" & StrDay
    StrDateTime = StrDate & "_" & StrTime
    RegX.Pattern = "[\:\/\ ]"
    RegX.IgnoreCase = True
    RegX.Global = True
    ArrangedDate = RegX.Replace(StrDateTime, "-")
ExitFunction:
    Set RegX = Nothing
End Function
 
Sub GetFolder(Folders As Collection, EntryID As Collection, StoreID As Collection, Fld As  _
MAPIFolder)
    Dim SubFolder       As MAPIFolder
    Folders.Add Fld.FolderPath
    EntryID.Add Fld.EntryID
    StoreID.Add Fld.StoreID
    For Each SubFolder In Fld.Folders
        GetFolder Folders, EntryID, StoreID, SubFolder
    Next SubFolder
ExitSub:
    Set SubFolder = Nothing
End Sub
 
Function BrowseForFolder(Optional OpenAt As String) As String
    Dim ShellApp As Object
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
        If Left(BrowseForFolder, 1) = ":" Then
            BrowseForFolder = ""
        End If
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then
            BrowseForFolder = ""
        End If
    Case Else
        BrowseForFolder = ""
    End Select
ExitFunction:
    Set ShellApp = Nothing
End Function


Bild

Betrifft: AW: FSO.CreateFolder
von: Henry
Geschrieben am: 23.09.2015 10:25:10
Guten Morgen Zusammen,
vielleicht hat jemand anderes noch Zeit mir zu helfen ?
Ich würde gerne den Teil ersetzen:

  
    For i = 1 To Folders.Count
        StrFolder = StripIllegalChar(Folders(i))
        n = InStr(3, StrFolder, "\") + 1
        StrFolder = Mid(StrFolder, n, 256)
        StrFolderPath = StrSavePath & StrFolder & "\"
        StrSaveFolder = Left(StrFolderPath, Len(StrFolderPath) - 1) & "\"
        If Not FSO.FolderExists(StrFolderPath) Then
            FSO.CreateFolder (StrFolderPath)
Das Makro soll einen ausgewählten Ordner aus Outlook auf die Festplatte speichern.
Dabei wird geprüft ob der Pfad = StrFolderPath als Ordner auf der Festplatte existiert.
Wenn nicht soll dieser über FSO.CreateFolder erstellt werden.
Hier gibt es aber ein Problem:
Wenn ich einen Unterordner aus dem Posteingang wähle ist der Pfad Posteingang\UnterordnerA
Beim Anlegen durchlaufen bleibt der Code an der Stelle stehen und sagt Pfad nicht gefunden.
Wenn ich am Speicherort aber einen Ordner Posteingang erstelle dann erstellt er den UnterordnerA korrekt. Soll bzw. muss aber auch gehen wenn es mehrere Ordnerebenen gibt die er zu erstellen hat.
Genau das sollte ja der Vorteil bei diesem Makro sein.,
Kann jemand helfen ?
Ganzer Code:
Option Explicit
Public lf As New LogFile
 
Sub SaveAllEmails_ProcessAllSubFolders()
    Dim i               As Long
    Dim j               As Long
    Dim n               As Long
    Dim StrSubject      As String
    Dim StrName         As String
    Dim StrFile         As String
    Dim StrReceived     As String
    Dim StrSavePath     As String
    Dim StrFolder       As String
    Dim StrFolderPath   As String
    Dim StrSaveFolder   As String
    Dim Prompt          As String
    Dim Title           As String
    Dim iNameSpace      As NameSpace
    Dim myOlApp         As Outlook.Application
    Dim SubFolder       As MAPIFolder
    Dim mItem           As MailItem
    Dim FSO             As Object
    Dim ChosenFolder    As Object
    Dim Folders         As New Collection
    Dim EntryID         As New Collection
    Dim StoreID         As New Collection
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set myOlApp = Outlook.Application
    Set iNameSpace = myOlApp.GetNamespace("MAPI")
    Set ChosenFolder = iNameSpace.PickFolder
    If ChosenFolder Is Nothing Then
GoTo ExitSub:
    End If
    Prompt = "Please enter the path to save all the emails to."
    Title = "Folder Specification"
    StrSavePath = BrowseForFolder
    If StrSavePath = "" Then
GoTo ExitSub:
    End If
    If Not Right(StrSavePath, 1) = "\" Then
        StrSavePath = StrSavePath & "\"
    End If
    lf.name = StrSavePath + "Post.log"
    Call GetFolder(Folders, EntryID, StoreID, ChosenFolder)
     
    For i = 1 To Folders.Count
        StrFolder = StripIllegalChar(Folders(i))
        n = InStr(3, StrFolder, "\") + 1
        StrFolder = Mid(StrFolder, n, 256)
        StrFolderPath = StrSavePath & StrFolder & "\"
        StrSaveFolder = Left(StrFolderPath, Len(StrFolderPath) - 1) & "\"
        If Not FSO.FolderExists(StrFolderPath) Then
            FSO.CreateFolder (StrFolderPath)
        End If
        Set SubFolder = myOlApp.Session.GetFolderFromID(EntryID(i), StoreID(i))
        On Error Resume Next
        For j = 1 To SubFolder.Items.Count
            Set mItem = SubFolder.Items(j)
'            StrReceived = ArrangedDate(mItem.ReceivedTime)
            StrReceived = Format(mItem.ReceivedTime, "yyyy-mm-dd_hh-nn-ss")
            StrSubject = mItem.Subject
            StrName = StripIllegalChar(StrSubject)
            StrFile = StrSaveFolder & StrReceived & "_" & StrName
            StrFile = Left(StrFile, 200) & ".msg"
            lf.LFInfo StrReceived & "<|>" & StrName & "<|>" & mItem.Sender.name & "<|>" & mItem. _
To & "<|>" & mItem.CC & "<|>" & StrFile
            mItem.SaveAs StrFile, 3
        Next j
        On Error GoTo 0
    Next i
ExitSub:
End Sub
 
Function StripIllegalChar(StrInput)
    Dim RegX            As Object
    Set RegX = CreateObject("vbscript.regexp")
    RegX.Pattern = "[\" & Chr(34) & Chr(10) & Chr(13) & "\!\@\#\$\%\^\&\*\(\)\=\+\|\[\]\{\}\`\'\ _
;\:\<\>\?\/\,]"
    RegX.IgnoreCase = True
    RegX.Global = True
    StripIllegalChar = RegX.Replace(StrInput, "")
ExitFunction:
    Set RegX = Nothing
End Function
 
Function ArrangedDate(StrDateInput)
    Dim StrFullDate     As String
    Dim StrFullTime     As String
    Dim StrAMPM         As String
    Dim StrTime         As String
    Dim StrYear         As String
    Dim StrMonthDay     As String
    Dim StrMonth        As String
    Dim StrDay          As String
    Dim StrDate         As String
    Dim StrDateTime     As String
    Dim RegX            As Object
    Set RegX = CreateObject("vbscript.regexp")
    If Not Left(StrDateInput, 2) = "10" And _
    Not Left(StrDateInput, 2) = "11" And _
    Not Left(StrDateInput, 2) = "12" Then
        StrDateInput = "0" & StrDateInput
    End If
    StrFullDate = Left(StrDateInput, 10)
    If Right(StrFullDate, 1) = " " Then
        StrFullDate = Left(StrDateInput, 9)
    End If
    StrFullTime = Replace(StrDateInput, StrFullDate & " ", "")
    If Len(StrFullTime) = 10 Then
        StrFullTime = "0" & StrFullTime
    End If
    StrAMPM = Right(StrFullTime, 2)
    StrTime = StrAMPM & "-" & Left(StrFullTime, 8)
    StrYear = Right(StrFullDate, 4)
    StrMonthDay = Replace(StrFullDate, "/" & StrYear, "")
    StrMonth = Left(StrMonthDay, 2)
    StrDay = Right(StrMonthDay, Len(StrMonthDay) - 3)
    If Len(StrDay) = 1 Then
        StrDay = "0" & StrDay
    End If
    StrDate = StrYear & "-" & StrMonth & "-" & StrDay
    StrDateTime = StrDate & "_" & StrTime
    RegX.Pattern = "[\:\/\ ]"
    RegX.IgnoreCase = True
    RegX.Global = True
    ArrangedDate = RegX.Replace(StrDateTime, "-")
ExitFunction:
    Set RegX = Nothing
End Function
 
Sub GetFolder(Folders As Collection, EntryID As Collection, StoreID As Collection, Fld As  _
MAPIFolder)
    Dim SubFolder       As MAPIFolder
    Folders.Add Fld.FolderPath
    EntryID.Add Fld.EntryID
    StoreID.Add Fld.StoreID
    For Each SubFolder In Fld.Folders
        GetFolder Folders, EntryID, StoreID, SubFolder
    Next SubFolder
ExitSub:
    Set SubFolder = Nothing
End Sub
 
Function BrowseForFolder(Optional OpenAt As String) As String
    Dim ShellApp As Object
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
        If Left(BrowseForFolder, 1) = ":" Then
            BrowseForFolder = ""
        End If
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then
            BrowseForFolder = ""
        End If
    Case Else
        BrowseForFolder = ""
    End Select
ExitFunction:
    Set ShellApp = Nothing
End Function



Bild

Betrifft: AW: FSO.CreateFolder
von: Daniel
Geschrieben am: 23.09.2015 10:27:33
Hi
du musst die Sub "PfadErstellen" in ein allgemeines Modul schreiben und dann
diesen Code:

If Not FSO.FolderExists(StrFolderPath) Then
    FSO.CreateFolder (StrFolderPath)
End If

durch diesen ersetzen:
Call PfadErstellen(StrFolderPath)

die Prüfung, ob der Pfad schon vorhanden ist, ist nicht notwendig, denn dann läuft die Sub einfach durch.
allerdings sollte bei StrFolderPath kein "\" am Ende stehen.
oder du musst die Sub noch so eränzen:
Sub PfadErstellen(Pfad As String)
Dim PfadTeile
Dim Pfad1
Dim i As Long
PfadTeile = Split(Left(Pfad),Len(Pfad) - IIF(Right(Pfad, 1)="\",1,0)), "\")
Pfad1 = PfadTeile(0)
...

gruß Daniel

Bild

Betrifft: AW: FSO.CreateFolder
von: Henry
Geschrieben am: 23.09.2015 10:31:52
ich Depp!! Danke Daniel!!!!! Jetzt funkts.

Bild

Betrifft: AW: FSO.CreateFolder
von: Henry
Geschrieben am: 23.09.2015 10:53:17
Hi Daniel,
beim testen ist mitr gerad aufgefallen wenn man mehrere Unterordner hat siehts auf der Festplatte doch ziemlich wild aus.
C:\Posteingang\UnterornderA\UnterordnerB\UnterordnerC\etc
Wie müsste ich die deklaration im Pfad änder, so dass er wirklich nur den letzten UnterordnerC ohne den kompletten Pfad erstellt ?


Bild

Betrifft: AW: FSO.CreateFolder
von: Daniel
Geschrieben am: 23.09.2015 11:00:03
Hi
ein Computerprogramm kann nicht hellsehen.
du musst immer genau die Ordnerstruktur angeben, die du auch haben willst.
wenn du den UnterordnerC haben willst, dann solltest du schon wissen, in welchem Übergeordneten Verzeichnis du den Ordner haben willst und wenn der UnterordnerC im UnterordnerA erscheinen soll, dann darfst du auch nur das angeben:
"C:\Posteingang\UnterornderA\UnterordnerC"
mein Programm erstellt immer genau die Ordnerstrukutr, die du vorgibst.
Gruß Daniel

Bild

Betrifft: AW: FSO.CreateFolder
von: Henry
Geschrieben am: 23.09.2015 11:08:04
Hi Daniel,
ja klar verstehe ich das schon,
Also gespeichert hat er den kompletten Pfad und legt diese an.
Das ist ja soweit auch genau richtig.
Was müsste man ändern damit er jetzt nur noch den letzten Ordner als Pfad nimmt ?
C:\unterordnerC
statt
C:\Posteingang\UnterornderA\UnterordnerB\UnterordnerC\etc
In dem eigentlich Code ist ChosenFolder deklariert, der genau nur diese Bezeichnung hat.
Wenn ich jedoch
StrFolderPath = StrFolder & "\"
durch
StrFolderPath = ChosenFolder & "\"
ersetze bekomme ich einen Fehler beim Zugriff auf Pfad/Datei und makiert bei MkDir Pfad1
MkDir Pfad1 zeigt aber eigentlich nur noch UnterordnerC korrekt an...

Bild

Betrifft: AW: FSO.CreateFolder
von: Daniel
Geschrieben am: 23.09.2015 11:29:49
Hi
wenn du aus:
"C:\Posteingang\UnterornderA\UnterordnerB\UnterordnerC"
"C:\UnterordnerC"
machen willst dann:

Pfad1 = "C:\Posteingang\UnterornderA\UnterordnerB\UnterordnerC"
Pfad2 = Left(Pfad1, 2) & Right(Pfad1, InstrRev(Pfad1, "\"))
dann wird aber der UnterornderC direkt ins RootVerzeichnis gestellt.
Gruß Daniel

 Bild

Beiträge aus den Excel-Beispielen zum Thema "VBA Excel schützen"