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