VBA Excel: Move File/ Folder From Location A to Location B Base on list.

harky

Active Member
Joined
Apr 8, 2010
Messages
405
Office Version
  1. 2021
  2. 2019
Platform
  1. Windows
ABC
Source PathDestination PathStatus
C:\Users\ABC\Desktop\TEST\75371C:\Users\ABC\Success
C:\Users\ABC\Desktop\TEST\75371\123.docC:\Users\ABC\Check Path/File

I had this code but not working. it seen like moving only 1 file... than had some repeat error



VBA Code:
Sub Move_Files()
Dim sCell As Range, eCell As Range
Dim sResult As String
Dim fromString As String, toString As String

For Each sCell In Sheets("MoveFiles").Range("A" & Rows.Count).End(xlUp)
fromString = TrailSep(sCell.Offset(0, 1).Value) & sCell.Value
toString = TrailSep(sCell.Offset(0, 1).Value) & sCell.Value
sResult = MoveFile(fromString, toString)
Set eCell = Sheets("ERROR").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
eCell.Resize(1, 3).Value = Range(sCell, sCell.Offset(0, 2)).Value
eCell.Offset(0, 3).Value = sResult
Next sCell
End Sub

Function MoveFile(sFrom As String, sTo As String, Optional tfOverWrite As Boolean = True) As String
If Dir(sFrom) = "" Then
MoveFile = "From File Does Not Exist"
Exit Function
End If

If Dir(FolderPart(sFrom), vbDirectory) = "" Then
MoveFile = "From Folder Does Not Exist"
Exit Function
End If

If Dir(FolderPart(sFrom), vbDirectory) = "" Then
MoveFile = "From Folder Does Not Exist"
Exit Function
End If

CreateFolder FolderPart(sTo)
If Dir(FolderPart(sTo), vbDirectory) = "" Then
MoveFile = "To Folder Does Not Exist"
Exit Function
End If

If Dir(sTo) <> "" And tfOverWrite = False Then
MoveFile = "To File Exists: File Not Moved"
Exit Function
End If

If Dir(sTo) <> "" Then Kill sTo
If Dir(sFrom) <> "" Then Name sFrom As sTo

If Dir(sTo) <> "" Then
MoveFile = "File Was Moved"
Exit Function
End If

MoveFile = "File Was NOT Moved"
End Function

Sub CreateFolder(sPath As String)
Dim a() As String, s As String, subF
a() = Split(sPath, "\")
On Error Resume Next
s = ""
For Each subF In a()
s = s & subF & "\"
ChDrive Left(s, 1)
MkDir s
Next subF
End Sub

Function FolderPart(sPath As String) As String
FolderPart = Left(sPath, InStrRev(sPath, "\"))
End Function

Function FilenamePart(sFullname As String) As String
FilenamePart = Mid(sFullname, InStrRev(sFullname, "\") + 1)
End Function

Function TrailSep(str As String) As String
If Right(str, 1) = Application.PathSeparator Then
TrailSep = str
Else: TrailSep = str & Application.PathSeparator
End If
End Function
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.

Forum statistics

Threads
1,223,099
Messages
6,170,107
Members
452,302
Latest member
TaMere

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
Back
Top