VBA Code to move subfolders and all files from source folder to destination folder

[kiranmalepat]

I have source folderand destination folder list in column A & Column B in excel. Looking to move subfolders and files in source folder to destination folder.

The below code is working if i directly give source path and destination path in VBA code.

Sub MoveFilesAndSubfolders()
Dim SourceFolder As String
Dim DestinationFolder As String
Dim FSO As Object
Dim Source As Object
Dim Destination As Object

' Set the source and destination folder paths
SourceFolder = "C:\SourceFolder\"
DestinationFolder = "C:\DestinationFolder\"

' Create a FileSystemObject
Set FSO = CreateObject("Scripting.FileSystemObject")

' Get the source folder
Set Source = FSO.GetFolder(SourceFolder)

' Loop through each file in the source folder
For Each File In Source.Files
' Move the file to the destination folder
FSO.MoveFile File.Path, DestinationFolder & File.Name
Next File

' Loop through each subfolder in the source folder
For Each Subfolder In Source.Subfolders
' Move the subfolder to the destination folder
FSO.MoveFolder Subfolder.Path, DestinationFolder & Subfolder.Name
Next Subfolder

' Clean up
Set FSO = Nothing
Set Source = Nothing
Set Destination = Nothing

MsgBox "Files and subfolders have been moved."
End Sub
-----------------------------------------------------------------------------------------

Since i have multiple source and desitination folders in excel. I am trying this. Howvever getting run time error permission denied. Please help me on this.


Sub MoveFilesAndSubfolders()

Dim SourceFolder As String

Dim DestinationFolder As String

Dim FSO As Object

Dim Source As Object

Dim Destination As Object

Dim x As Integer

For x = 0 To 100

' Set the source and destination folder paths

SourceFolder = Sheets("Folder List").Cells(x + 2, 1).Value
DestinationFolder = Sheets("Folder List").Cells(x + 2, 2).Value

If SourceFolder <> "" Then

' Create a FileSystemObject
Set FSO = CreateObject("Scripting.FileSystemObject")

' Get the source folder
Set Source = FSO.GetFolder(SourceFolder)
' Loop through each file in the source folder
For Each file In Source.Files
' Move the file to the destination folder
FSO.MoveFile file.PATH, DestinationFolder & file.Name
Next file

' Loop through each subfolder in the source folder

For Each SubFolder In Source.Subfolders

' Move the subfolder to the destination folder

FSO.MoveFolder SubFolder.PATH, DestinationFolder & SubFolder.Name
Next SubFolder

Else
End If

' Clean up
Set FSO = Nothing
Set Source = Nothing
Set Destination = Nothing
Next x
x = x + 1
MsgBox "Files and subfolders have been moved."
End Sub


Thank you

 

[Peter_SSs]

Duplicate to: Vba code to move subfolders and all files to different folder
In future, please do not post the same question multiple times. Per Forum Rules (#12), posts of a duplicate nature will be locked or deleted.

In relation to your question here, I have closed this thread so please continue in the linked thread. If you do not receive a response, you can "bump" it by replying to it yourself, though we advise you to wait 24 hours before doing so, and not to bump a thread more than once a day.