harky
08-26-2019, 02:00 AM
Hi, i really need some help. I had many folder to move https://www.mrexcel.com/forum/images/smilies/icon_smile.gif
I want to move all inside files inside folder on col A to folder col B
*No overwrite of same filename
*delete empty folder of Col A (NOT COL B)
*New folder will created if destination doesn't exist.
From Folder (Col A)
Source
Move to Folder (Col B)
Destination
Status (Col C)
\\abc\folder1\
\\abc\Main1\
Files Moved / No files in Source Path / Files already exist
\\abc\folder2\
\\abc\Main1\
Moved
\\abc\folder3\
\\abc\Main2\
Moved
\\abc\folder4\
\\abc\Main2\
Moved
\\abc\folder5\
\\abc\Main2\
Moved
If Len(FNames) = 0 Then
Cells(i, 3).Value = "No files in Source Path"
Else
Cells(i, 3).Value = "Files already exist"
End If
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, 1).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
I want to move all inside files inside folder on col A to folder col B
*No overwrite of same filename
*delete empty folder of Col A (NOT COL B)
*New folder will created if destination doesn't exist.
From Folder (Col A)
Source
Move to Folder (Col B)
Destination
Status (Col C)
\\abc\folder1\
\\abc\Main1\
Files Moved / No files in Source Path / Files already exist
\\abc\folder2\
\\abc\Main1\
Moved
\\abc\folder3\
\\abc\Main2\
Moved
\\abc\folder4\
\\abc\Main2\
Moved
\\abc\folder5\
\\abc\Main2\
Moved
If Len(FNames) = 0 Then
Cells(i, 3).Value = "No files in Source Path"
Else
Cells(i, 3).Value = "Files already exist"
End If
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, 1).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