Hi,
in my opinion it is easier to delete the Folder with Files and the recreate the Folder structure.
here a sample to create a Folder structure like ... C:\Chris\Test\Test2\Test3
regardsCode:Option Explicit Private Sub Command1_Click() Dim Msg As String Dim Titel As String Dim IsOk As Boolean Dim Result As String Dim i As Long Dim s As String Titel = "Create Folder " Do Msg = "Enter Path and Foldernames.... " & _ vbNewLine & _ vbCrLf & "sample: D:\MyDB\MyPic\MyHelp" Result = InputBox(Msg, "Create Path\Folder(s)") If Len(Result) = 0 Then Msg = "you did not enter a Path\Folder" MsgBox Msg, vbInformation, Titel Exit Sub End If s = Result IsOk = True If IsOk Then s = Result MsgBox FolderCreateNew(s) Exit Sub End If Loop End Sub Public Function FolderCreateNew(Path As String, _ Optional ShowError As Boolean = True) As Boolean Dim s As String Dim s1() As String Dim s2 As String Dim Titel As String Dim i As Long Titel = "FolderCreate" If Len(Trim(Path)) = 0 Then If ShowError Then FehlerAnzeige 4711, "Path without Folder", Titel End If Exit Function End If s = Replace(Trim(Path), "\\", "\") If Right(s, 1) = "\" Then s = Left$(s, Len(s) - 1) End If s1() = Split(s, "\") 'gibt es den Pfad schon s2 = Join(s1(), "\") If Len(Dir(s2, vbDirectory)) > 0 Then If ShowError Then FehlerAnzeige 4712, "Path " & Path & vbCrLf & _ "exits", Titel End If Exit Function End If s2 = s1(LBound(s1)) 'test for Drive If Len(Dir(s2)) = 0 Then If ShowError Then FehlerAnzeige 4712, "Drive " & s2 & " does not exist", Titel End If Exit Function End If On Error GoTo Fehler For i = LBound(s1) + 1 To UBound(s1) s2 = s2 & "\" & s1(i) If Len(Dir(s2, vbDirectory)) = 0 Then 'Folder doesn't exist so create it MkDir s2 End If Next FolderCreateNew = True Exit Function Fehler: If ShowError Then FehlerAnzeige Err.Number, Err.Description, Titel End If End Function Public Sub FehlerAnzeige(ErrNumber As Long, ErrDescription As String, _ Optional Titel As String = "") Dim Msg As String Msg = "Fehler " & ErrNumber & vbCrLf & vbCrLf & _ ErrDescription MsgBox Msg, vbCritical, Titel End Sub
Chris




Reply With Quote