move files to folder

[JAVEDR]

Hello,

Able to create folder and move files from below code but if folder exist unable to move that file-

From Folder (Col A)	Move to Folder (Col B)
\\abc\folder1\	\\abc\Main1\
\\abc\folder2\	\\abc\Main1\
\\abc\folder3\	\\abc\Main2\
\\abc\folder4\	\\abc\Main2\
\\abc\folder5\	\\abc\Main2\

Sub Move_Files_To_NewFolder()
'http://www.rondebruin.nl/folder.htm


'This example move all Excel files from FromPath to ToPath.
'Note: It will create the folder ToPath for you


Dim FSO As Object
Dim FromPath As String, ToPath As String
Dim FileExt As String, FNames As String
Dim LR As Long, i As Long


LR = Cells(Rows.Count, 2).End(xlUp).Row


For i = 2 To LR
    FromPath = Range("A" & i).Value
    ToPath = Range("B" & i).Value
    FileExt = "*.*" '<< Change / You can use *.* for all files or *.doc* for word files
    If Right(FromPath, 1) <> "" Then FromPath = FromPath & ""
    FNames = Dir(FromPath & FileExt)
    If Len(FNames) = 0 Then MsgBox "No files in " & FromPath
    Set FSO = CreateObject("scripting.filesystemobject")
    FSO.CreateFolder (ToPath)
    FSO.MoveFile Source:=FromPath & FileExt, Destination:=ToPath
Next

End Sub

 

[Colo]

Hi,
if the folder already exists, no need to create a folder. So change code like this.

If Dir(ToPath, vbDirectory) = "" Then FSO.CreateFolder (ToPath)

 

[JEC]

Can be done with:

Name oldPath as newPath

 

[JAVEDR]

Hi,
if the folder already exists, no need to create a folder. So change code like this.

If Dir(ToPath, vbDirectory) = "" Then FSO.CreateFolder (ToPath)

thanks sir for your reply, where should I add or change above code can you please guide.

 

[JAVEDR]

Can be done with:

Name oldPath as newPath

thanks sir for your reply, where should I add or change above code can you please guide.

 

[JAVEDR]

Hi,
if the folder already exists, no need to create a folder. So change code like this.

If Dir(ToPath, vbDirectory) = "" Then FSO.CreateFolder (ToPath)

Thank you sir its working