Copy All Files from Folder to Folder Excel VBA
This article reviews how to copy all files from folder to folder with Excel VBA. Basically, the below code copies all files from a particular folder "Move Files" to the folder "Here" located on my desktop. Environ("UserProfile") returns the current logged in user's name so that the path for the folders are customized to the currently logged in user that wants to move the files. The below are two separate subprocedures in the same module. Just enable Microsoft Scripting Runtime in Visual Basic Editor in the Tools – References on the menu.
Option Explicit
Dim fso As Scripting.FileSystemObject
Dim NewFolderPath As String
Sub UsingTheScriptingRunTimeLibrary()
'This Macro Copies the Original Files to a New Folder Path
Dim OldFolderPath As String
'UserProfile References View-->Immediate Window--> User Unspecific
NewFolderPath = Environ("UserProfile") & "\Onedrive\Desktop\Here"
OldFolderPath = Environ("UserProfile") & "\Onedrive\Desktop\Move Files"
Set fso = New Scripting.FileSystemObject
If fso.FolderExists(OldFolderPath) Then
'creates a new folder called NEWVBA var NewFolderPath ((DIM2))
If Not fso.FolderExists(NewFolderPath) Then
fso.CreateFolder NewFolderPath
End If
Call CopyExcelFiles(OldFolderPath)
End If
Set fso = Nothing
End Sub
Sub CopyExcelFiles(StartFolderPath As String)
Dim fil As Scripting.File
Dim SubFol As Scripting.Folder
Dim OldFolder As Scripting.Folder
Set OldFolder = fso.GetFolder(StartFolderPath)
For Each fil In OldFolder.Files
Debug.Print fil.Name
fil.Copy NewFolderPath & "\" & fil.Name
Next fil
For Each SubFol In OldFolder.SubFolders
Call CopyExcelFiles(SubFol.Path)
Next SubFol
End Sub
You can remove the below code from the code if you don't want the subfolder files from the "Move Files" folder to move to the "Here" Folder.
For Each SubFol In OldFolder.SubFolders
Call CopyExcelFiles(SubFol.Path)
Next SubFol
The below code is separate from everything above. The below code puts all the file names in folder "C:\Users\18622\OneDrive\Desktop\Here\" into column A in the workbook.
Sub GetFiles()
Dim myfile As String
Dim nextrow As Integer
nextrow = 1
With Worksheets("Sheet1").Range("A1")
myfile = Dir("C:\Users\18622\OneDrive\Desktop\Here\*.*", vbNormal)
.Value = myfile
Do While myfile <> ""
myfile = Dir
.Offset(nextrow, 0).Value = myfile
nextrow = nextrow + 1
Loop
End With
End Sub