This code transfers filenames from one folder. How do add multiple file paths so it can transfer file names from multiple folders.
Sub get_files()
Dim FsysObj As Object
Dim objFolder As Object
Dim objFiles As Object
Dim SplitArray() As String
Dim ID() As String
Dim rowNo As Integer
Dim fileName As String
filepath = "D:/user"
Set FsysObj = CreateObject("Scripting.FileSystemObject")
Set objFolder = FsysObj.GetFolder(filepath)
'clear the sheets
Sheet1.Rows("1:" & Rows.Count).Delete
Sheet1.Cells(1, 1).Value = "Lastname"
Sheet1.Cells(1, 2).Value = "Firstname"
Sheet1.Cells(1, 3).Value = "ID"
rowNo = 2
For Each file In objFolder.Files
FirstName = Null
LastName = Null
ids = Null
'get Base name of a file without extension
fileName = CreateObject("Scripting.FileSystemObject").GetBaseName(file.Name)
SplitArray = Split(fileName, ", ")
LastName = SplitArray(0)
'Split with space to getting id and first name
If UBound(SplitArray) = 1 Then
ID = Split(SplitArray(1), " ")
Else
LastName = Null
End If
If (UBound(ID) = 1) Then
FirstName = ID(0)
ids = ID(1)
End If
'All values are found then stored it into excel sheet
If Not (IsNull(FirstName) Or IsNull(LastName) Or IsNull(ids)) Then
Sheet1.Cells(rowNo, 1).Value = LastName
Sheet1.Cells(rowNo, 2).Value = FirstName
Sheet1.Cells(rowNo, 3).Value = ids
rowNo = rowNo + 1
End If
Next file
End Sub