Moving files from one folder to another

[Kenneth Hobs]

It would have been better to start a new thread and add a link to this one since the solution is similar. Please mark this thread solved.

You can not just rename a Sub and expect it to do something other than what it was designed to do. Luckily, there is only one line that has to be recoded to make it work. However, I also changed a few lines to make it clear that the file was copied rather than moved. See the last VBA code below for the FileCopy() routine.

The line in the other to rename the file uses the class FileSystem and method Name(). In this code, I used the method FileCopy().

Press F2 in the VBE, Visual Basic Editor, to browse. Select the VBA library from the dropdown list or All Libraries. Then choose the FileSystem class. Of course you could just type FileSystem. and the . would make the members show if you have the VBE option set to Auto List Members. If the . does not work, select Tools > Options in VBE, and check that option.

To explore other methods, search this forum for FSO, File System Object. To explore that object's methods, see the following code for examples and links to help for FSO. I used early binding so you will have to add the reference from VBE's Tools > References as explained in the code comments. The API guide link is another method but more involved. The FSO method does many of the same methods as the API routines but it is easier to use since early binding the FSO object allows intellisense to work in the VBE for that object.
[vba]'http://allapi.mentalis.org/agnet/apiguide.shtml
'script56.chm, http://tinyurl.com/5ts6r8
Sub MoveFolder()
Rem Needs Reference: MicroSoft Script Runtime, scrrun.dll
Rem Instructions: http://support.microsoft.com/default...b;en-us;186118
Dim FSO As Scripting.FileSystemObject
Dim sSource As String
Dim sDest As String

Set FSO = New Scripting.FileSystemObject

sSource = Range("A1").Value
sDest = Range("A2").Value
FSO.MoveFolder sSource, sDest
End Sub
Sub CopyFolder()
Rem Needs Reference: MicroSoft Script Runtime, scrrun.dll
Rem Instructions: http://support.microsoft.com/default...b;en-us;186118
Dim FSO As Scripting.FileSystemObject
Dim sSource As String
Dim sDest As String

Set FSO = New Scripting.FileSystemObject

sSource = Range("A1").Value
sDest = Range("A2").Value

FSO.CopyFolder sSource, sDest, True
End Sub[/vba]
Here is your CopyFile Sub with the same supporting Subs as shown earlier.
[vba]Option Explicit
Sub Copy_Files()
Dim sCell As Range, eCell As Range
Dim sResult As String
Dim fromString As String, toString As String

For Each sCell In Sheets("Sheet1").Range("A10", _
Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp))
fromString = TrailSep(sCell.Offset(0, 1).Value) & sCell.Value
toString = TrailSep(sCell.Offset(0, 2).Value) & sCell.Value
sResult = CopyFile(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 CopyFile(sFrom As String, sTo As String, Optional tfOverWrite As Boolean = True) As String
If Dir(sFrom) = "" Then
CopyFile = "From File Does Not Exist"
Exit Function
End If

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

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

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

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

If Dir(sTo) <> "" Then Kill sTo
If Dir(sFrom) <> "" Then FileCopy sFrom, sTo

If Dir(sTo) <> "" Then
CopyFile = "File Was Copied"
Exit Function
End If
CopyFile = "File Was NOT Copied"
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
[/vba]