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

[harky]

A	B	C
Source Path	Destination Path	Status
C:\Users\ABC\Desktop\TEST\75371	C:\Users\ABC\	Success
C:\Users\ABC\Desktop\TEST\75371\123.doc	C:\Users\ABC\	Check Path/File

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

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