View Single Post
 
Old 04-17-2023, 07:27 AM
gmayor's Avatar
gmayor gmayor is offline Windows 10 Office 2019
Expert
 
Join Date: Aug 2014
Posts: 4,137
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

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
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote