Option Explicit
Sub MoveMyFile()
Dim sSource As String
Dim sDestination As String
' \\ build paths..change to your FileName
' \\ The path of the source document
sSource = ThisDocument.Path & "\Test.doc"
' \\ The path of the destination document
sDestination = ThisDocument.Path & "\Test\Test Moved.doc"
' \\ Call function to move file
Call FSOMoveFile(sSource, sDestination, False)
End Sub
' \\ This function moves a file from it's source location to the
' \\ destination location. If bOverwrite is true a exesting file
' \\ in source location is overwritten
Public Sub FSOMoveFile(sSource As String, _
sDestination As String, _
bOverwrite As Boolean)
Dim FSO As Object
On Error Goto Oops
Set FSO = CreateObject("Scripting.FileSystemObject")
' \\ Check if Source file exists if not exit sub
If Not fFileExists(FSO, sSource) Then
MsgBox "Source file: " & sSource & " doesn't exist", vbCritical
Goto ExitOops
End If
' \\ Check if Destiantion file exists if so exit sub
If fFileExists(FSO, sDestination) And bOverwrite Then
' \\ Delete existing destination file first and then move the file
With FSO
.DeleteFile (sDestination)
.MoveFile sSource, sDestination
End With
ElseIf fFileExists(FSO, sDestination) And Not bOverwrite Then
' \\ Not allowed to overwrite existing file so exit
Goto ExitOops
Else
' \\ If source file exists and Destination file doesn't
' \\ This will move the document to the new location.
FSO.MoveFile sSource, sDestination
End If
' \\ Clean Up
ExitOops:
Set FSO = Nothing
Exit Sub
Oops:
MsgBox "Error # " & Str(Err.Number) & " " & Err.Description
Resume ExitOops
End Sub
' \\ Function to check if file exists
Public Function fFileExists(FSO As Object, sPath As String)
If FSO.FileExists(sPath) Then fFileExists = True
End Function
|