Try the following:
Code:
Sub FileCopyTo()
Dim sName As String, sOriginal As String
Dim vPath() As Variant
Dim i As Integer
vPath = Array("C:\My doc\", "F:\My doc\", "G:\My doc\", "H:\My doc\")
ActiveDocument.Save
sOriginal = ActiveDocument.FullName
sName = ActiveDocument.Name
For i = 0 To UBound(vPath)
If FolderExists(CStr(vPath(i))) Then
ActiveDocument.SaveAs2 FileName:=CStr(vPath(i)) & sName, FileFormat:=wdFormatXMLDocument
End If
Next i
ActiveDocument.SaveAs2 FileName:=sOriginal, FileFormat:=wdFormatXMLDocument
End Sub
Private Function FolderExists(strFolderName As String) As Boolean
'Graham Mayor
'strFolderName is the name of folder to check
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
If (FSO.FolderExists(strFolderName)) Then
FolderExists = True
Else
FolderExists = False
End If
lbl_Exit:
Set FSO = Nothing
Exit Function
End Function