Hallo,
das ist möglich, gibt einige Funktionen im Netz dazu wenn du nach "VBA Files im ordner auflisten" suchst.
Hab mir dieses Modul dazu angelegt:
Option Explicit
Private Sub Beispielaufruf()
Dim FileList$(), I&, List$()
DirectoryContent List, ThisWorkbook.Path
For I = 0 To UBound(List)
MsgBox List(I)
Next
End Sub
Function DirectoryContent( _
List$(), ByVal sPath$, _
Optional ByVal bSubfolders As Boolean = False, _
Optional ByVal sFilenameFilter$ = "*", _
Optional ByVal sExtensionFilter$ = "*" _
) As String
Dim oFS As Object, OFolder As Object, oSubfolder As Object, oFile As Object
Dim Count&
'set
DirectoryContent = "No Files found"
If FolderDoesntExist(sPath) Then
DirectoryContent = "Folder doesn't exist"
Exit Function
End If
Set oFS = CreateObject("Scripting.FileSystemObject")
Set OFolder = oFS.GetFolder(sPath)
'search
For Each oFile In OFolder.Files
If oFile.Name Like sFilenameFilter & "." & sExtensionFilter Then
ReDim Preserve List(Count)
List(Count) = oFile.Path
Count = Count + 1
DirectoryContent = vbNullString
End If
Next
If bSubfolders Then
For Each oSubfolder In OFolder.SubFolders
For Each oFile In oSubfolder.Files
If oFile.Name Like sFilenameFilter & "." & sExtensionFilter Then
ReDim Preserve List(Count)
List(Count) = oFile.Path
Count = Count + 1
DirectoryContent = vbNullString
End If
Next
Next
End If
'clear
Set oFS = Nothing
Set oFile = Nothing
Set oSubfolder = Nothing
Set OFolder = Nothing
End Function
Private Function FolderDoesntExist(sPath$) As Boolean
Dim OFolder As Object
Dim oFS As Object
On Error GoTo FolderDoesNotExist
Set oFS = CreateObject("Scripting.FileSystemObject")
FolderDoesntExist = 0
Set OFolder = oFS.GetFolder(sPath)
Set oFS = Nothing
Set OFolder = Nothing
Exit Function
FolderDoesNotExist:
Set oFS = Nothing
Set OFolder = Nothing
FolderDoesntExist = 1
End Function
Function RenameFilesInDirectory(Directory As String, NewDir As String, Optional ByVal NotFile As String = "")
Dim X As Variant
Dim NewFile As String
Dim DirCont$()
DirectoryContent DirCont, Directory
On Error Resume Next
For Each X In DirCont
If Not X = "" Then
If Not X = NotFile Then
NewFile = NewDir & Right(X, Len(X) - Len(Directory))
Kill NewFile
Name X As NewFile
End If
End If
Next X
End Function
Die Rename Files Funktion hat eigentlich nichts damit zu tun, könnte dir aber vielleicht trotzdem weiter helfen. Die Name "oldfilename", "newfilename" funktion kann auch zum verschieben verwendet werden, da der File Name den Pfad beinhaltet.
|