Someone helped me with this macro (attached) to move files based on file paths many many years ago, it works perfectly. But my requirement sometimes demands that I 'cut-paste' the files rather than 'copy-paste'. I believe this is a very small edit needed in the code, but I'm clueless. Any help will be much appreciated.
Edit macro to 'cut-paste' instead of 'copy-paste'
-
Hyperventilate -
May 8, 2021 at 9:04 AM -
Thread is marked as Resolved.
-
-
-
Untested, try this and report back with any errors
Code
Display MoreSub MoveFile() Set FSO = CreateObject("scripting.filesystemobject") Dim SourcePath As String, dstPath As String, myFile As String 'On Error GoTo ErrHandler For r = 2 To Range("A" & Rows.Count).End(xlUp).Row SourcePath = Range("C" & r) dstPath = Range("D" & r) myFile = Range("A" & r) FSO.MoveFile Source:=SourcePath & Application.PathSeparator & myFile, Destination:=dstPath & Application.PathSeparator & myFile If Range("A" & r) = "" Then Exit For End If Next r MsgBox "The file(s) can found in: " & vbNewLine & dstPath, , "COPY COMPLETED" Exit Sub ErrHandler: MsgBox "Copy error: " & SourcePath & "\" & myFile & vbNewLine & vbNewLine & _ "File could not be found in the source folder", , "MISSING FILE(S)" End Sub
-
Untested, try this and report back with any errors
Works perfect Roy, thank you so much!
-
Pleased to help.
Post back if you need further help.
Visit my web site, http://www.excel-it.com, for more examples and some helpful articles.
-
Roy, this macro works perfect but it stops when a particular file is not found in the specified folder. Can we amend the code so it just makes a note of the missing file in another column and continues executing the movement?
-
-
What do you mean. I thought the table contained the names of all the files?
Is this caused by empty cells in the list?
If files might not exist then the code will need to check first.
Maybe
Code
Display MoreSub MoveFile() Set fso = CreateObject("scripting.filesystemobject") Dim SourcePath As String, dstPath As String, myFile As String 'On Error GoTo ErrHandler For r = 2 To Range("A" & Rows.Count).End(xlUp).Row If Range("A" & r) > "" Then SourcePath = Range("C" & r) dstPath = Range("D" & r) myFile = Range("A" & r) If fso.FileExists(SourcePath & Application.PathSeparator & myFile) Then fso.MoveFile Source:=SourcePath & Application.PathSeparator & myFile, Destination:=dstPath & Application.PathSeparator & myFile End If End If Next r MsgBox "The file(s) can found in: " & vbNewLine & dstPath, , "COPY COMPLETED" Exit Sub ErrHandler: MsgBox "Copy error: " & SourcePath & "\" & myFile & vbNewLine & vbNewLine & _ "File could not be found in the source folder", , "MISSING FILE(S)" End Sub
-
What do you mean. I thought the table contained the names of all the files?
Is this caused by empty cells in the list?
If files might not exist then the code will need to check first.
Employees are required to upload their photographs into one folder with file name as their Emp ID. I just generate the file names assuming everyone has uploaded the photos. But as is the case, not everyone has done it and the old macro stops when the file isn't found. Your new code runs and completes the move without stopping, but I'm unable to find out which files were not found in the folder.
-
This should highlight the problem cell in red
Code
Display MoreSub MoveFile() Set fso = CreateObject("scripting.filesystemobject") Dim SourcePath As String, dstPath As String, myFile As String 'On Error GoTo ErrHandler For r = 2 To Range("A" & Rows.Count).End(xlUp).Row If Range("A" & r) > "" Then SourcePath = Range("C" & r) dstPath = Range("D" & r) myFile = Range("A" & r) If fso.FileExists(SourcePath & Application.PathSeparator & myFile) Then fso.MoveFile Source:=SourcePath & Application.PathSeparator & myFile, Destination:=dstPath & Application.PathSeparator & myFile ElseRange("A" & r).Interior.coloindex = vbRed End If End If Next r MsgBox "The file(s) can found in: " & vbNewLine & dstPath, , "COPY COMPLETED" Exit Sub ErrHandler: MsgBox "Copy error: " & SourcePath & "\" & myFile & vbNewLine & vbNewLine & _ "File could not be found in the source folder", , "MISSING FILE(S)" End Sub
-
-
-
-
Code
Display MoreSub MoveFile() Set fso = CreateObject("scripting.filesystemobject") Dim SourcePath As String, dstPath As String, myFile As String 'On Error GoTo ErrHandler For r = 2 To Range("A" & Rows.Count).End(xlUp).Row If Range("A" & r) > "" Then SourcePath = Range("C" & r) dstPath = Range("D" & r) myFile = Range("A" & r) If fso.FileExists(SourcePath & Application.PathSeparator & myFile) Then fso.MoveFile Source:=SourcePath & Application.PathSeparator & myFile, Destination:=dstPath & Application.PathSeparator & myFile Else: Range("A" & r).Interior.colorindex = vbRed End If End If Next r MsgBox "The file(s) can found in: " & vbNewLine & dstPath, , "COPY COMPLETED" Exit Sub ErrHandler: MsgBox "Copy error: " & SourcePath & "\" & myFile & vbNewLine & vbNewLine & _ "File could not be found in the source folder", , "MISSING FILE(S)" End Sub
-
Really sorry for dragging this Roy, but it still shows an error. Please see screenshot.
-
There's an E in front of Sub that shouldn't be there.
-
Oops, fixed that and it's giving me a different error now. "Subscript out of range". Screenshot attached.
-
This works for me
Code
Display MoreSub MoveFile() Set fso = CreateObject("scripting.filesystemobject") Dim SourcePath As String, dstPath As String, myFile As String 'On Error GoTo ErrHandler For r = 2 To Range("A" & Rows.Count).End(xlUp).Row If Range("A" & r) > "" Then SourcePath = Range("C" & r) dstPath = Range("D" & r) myFile = Range("A" & r) If fso.FileExists(SourcePath & Application.PathSeparator & myFile) Then fso.MoveFile Source:=SourcePath & Application.PathSeparator & myFile, Destination:=dstPath & Application.PathSeparator & myFile Else: Range("A" & r).Interior.Color = vbRed End If End If Next r MsgBox "The file(s) can found in: " & vbNewLine & dstPath, , "COPY COMPLETED" Exit Sub ErrHandler: MsgBox "Copy error: " & SourcePath & "\" & myFile & vbNewLine & vbNewLine & _ "File could not be found in the source folder", , "MISSING FILE(S)" End Sub
-
-
Works perfect now, thank you so much!
-
Pleased to help.
Post back if you need further help.
Visit my web site, http://www.excel-it.com, for more examples and some helpful articles.
Participate now!
Don’t have an account yet? Register yourself now and be a part of our community!