VBA: Moving files to different folders

Ziri

New Member
Joined
Mar 19, 2020
Messages
5
Office Version
  1. 365
Platform
  1. Windows
Hello VBA Experts,

I have been trying to write a code for files (listed in column A) that I currently located in folder listed in column P to folders listed in column O. I have tried several approaches and have read many forums but without any results. Find below the last coda i tried but it is giving me "Invalide procedure call or argument" error. Could anyone push me the right direction please?

VBA Code:
Sub Move_Files_From_One_Folder_To_Another_Folder()
Dim FSO As Object
Dim FromDir As String
Dim ToDir As String
Dim FExtension As String
Dim FNames As String
  
  Sheets("Data").Activate

Dim A As String
Dim B As String
Dim C As String
Dim i As Long

    For i = 1 To 100000
    A = Range("A" & i)
B = Range("O" & i)
    C = Range("P" & i)
    Next
FromDir = C & A
ToDir = B & A
'We define here the types of files we wish to move. If you had .txt or .docx or .doc files you can use *.* as the FExtension
FExtension = "*.pdf"
'Now assign each file name with extension
FNames = Dir(FromDir & FExtension)
'Check whether there are any files in the folder so that you can exit if there are no files
If Len(FNames) = 0 Then

MsgBox ("No files in " & FromDir)
Exit Sub
End If
'Most methods return values but FSO returns an object. You cannot simply assign an object to a variable using an equals sign. In Excel VBA you need to use the Set statement
Set FSO = CreateObject("Scripting.FileSystemObject")
'Now we move the file from the source directory to the destination directory
FSO.MoveFile Source:=FromDir & FExtension, Destination:=ToDir
End Sub
 

LazyBug

Board Regular
Joined
Feb 28, 2020
Messages
159
Office Version
  1. 2010
Platform
  1. Windows
if the file doesn't exist
VBA Code:
Option Explicit

Sub MoveByList()
Dim fso, f, r: r = 2    'r - first row w data in A column

Set fso = CreateObject("Scripting.FileSystemObject")

Do While Not IsEmpty(Cells(r, 1))
    If fso.FileExists((Cells(r, 4)) & "\" & Cells(r, 2)) Then
        Set f = fso.GetFile((Cells(r, 4)) & "\" & Cells(r, 2))
        f.Move Cells(r, 3) & "\"
        r = r + 1
    Else
        MsgBox "File " & (Cells(r, 4)) & "\" & Cells(r, 2) & " doesn't exist"
        r = r + 1
    End If
Loop
End Sub
 

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN

Watch MrExcel Video

Forum statistics

Threads
1,132,976
Messages
5,656,184
Members
418,288
Latest member
reba557

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top