Hallo EXCEL-Freunde,
habe aus einem Beitrag von heute den Code (von Nepumuk) an meine Bedürfnisse
angepasst; nun scheitere ich daran, dass ich eine Schleife oder eine
"normale Fortsetzung" des Codes über eine MsgBox einbauen will:
(habs im code mit Fragezeichen gekennzeichnet)
Public Sub Daten_kopieren3()
' benötigt Verweis auf Microsoft Scripting Runtime
Dim myFileSystemObject As New FileSystemObject, myFolders As Folders
Dim myFolder As Folder, myFile As File, intIndex As Integer, lngZeile As Long
Application.ScreenUpdating = False
lngZeile = Range("A65536").End(xlUp).Row + 1
' Pfad abfragen
msg = "Wählen Sie bitte einen Ordner aus:"
Pfad1 = getdirectory(msg)
Set myFolder = myFileSystemObject.GetFolder(Pfad1)
Set myFolders = myFolder.SubFolders
Cells(lngZeile, 1) = Pfad1
lngZeile = lngZeile + 1
For Each myFolder In myFolders
Cells(lngZeile, 1) = myFolder.Name
lngZeile = lngZeile + 1
With Application.FileSearch
.LookIn = myFolder.Path
.FileType = msoFileTypeExcelWorkbooks
.Execute
For intIndex = 1 To .FoundFiles.Count
Set myFile = myFileSystemObject.GetFile(.FoundFiles(intIndex))
Cells(lngZeile, 2) = myFile.Name
lngZeile = lngZeile + 1
Next
End With
Next
Select Case MsgBox("Wollen Sie einen weiteren Pfad abfragen?", vbYesNoCancel)
Case vbYes
''''' Schleife ?'''''''
MsgBox "Ja"
Case vbNo
''''' GoTo?'''''''''''
MsgBox "Nein"
' Case vbCancel
' MsgBox "Abbrechen"
End Select
Set myFileSystemObject = Nothing
Set myFolders = Nothing
Set myFolder = Nothing
Set myFile = Nothing
Application.ScreenUpdating = True
End Sub

Code eingefügt mit: Excel Code Jeanie

Besten Dank für eine Hilfe!
mfg
Erich