一次将Word文件保存在多个位置

Posted 2021-05-01

我想在5个不同的位置保存一个word文件。我的主要问题是我的代码只有在我在save中指定一个名称时才有效。我试过这个，但没有运气：

  ChangeFileOpenDirectory _
    "O:\xxxx"
ActiveDocument.SaveAs FileName:=
    "O:\xxxx" & Split(ActiveDocument.Name, ".")(0) & ".doc", _
    , FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
    AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
    EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
    :=False, SaveAsAOCELetter:=False, CompatibilityMode:=15
    ChangeFileOpenDirectory _
    "O:\xxx"
ActiveDocument.SaveAs2 FileName:= _
    O:\xxxx" & Split(ActiveDocument.Name, ".")(0) & ".doc", _
    , FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
    AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
    EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
    :=False, SaveAsAOCELetter:=False, CompatibilityMode:=15
    ChangeFileOpenDirectory _
    "O:\xxx"
ActiveDocument.SaveAs2 FileName:= _
    O:\xxxx" & Split(ActiveDocument.Name, ".")(0) & ".doc", _
    , FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
    AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
    EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
    :=False, SaveAsAOCELetter:=False, CompatibilityMode:=15
    ChangeFileOpenDirectory _
    "O:xxxx"
ActiveDocument.SaveAs2 FileName:= _
    O:\xxxx" & Split(ActiveDocument.Name, ".")(0) & ".doc", _
    , FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
    AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
    EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
    :=False, SaveAsAOCELetter:=False, CompatibilityMode:=15
    ChangeFileOpenDirectory _
    "O:\xxx"
ActiveDocument.SaveAs2 FileName:= _
    O:\xxxx" & Split(ActiveDocument.Name, ".")(0) & ".doc", _
    , FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
    AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
    EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
    :=False, SaveAsAOCELetter:=False, CompatibilityMode:=15

文件路径都不同，但文件名应该相同。它基本上应该只是取打开文档的名称。

答案

好吧，我会在循环中做到这一点：

Sub daf()
    Dim docCopy As Document
    Dim sPath(4) As String
    Dim sFileName As String
    Dim i As Long

    sPath(0) = "C:\zzz"
    sPath(1) = "c:\ddd"
    sPath(2) = "C:\ttt"
    sPath(3) = "C:\yyy"
    sPath(5) = "C:\ooo"

    sFileName = Split(ActiveDocument.Name, ".")(0)
    Set docCopy = Application.Documents.Add(ActiveDocument.FullName)

    For i = 0 To UBound(sPath)
        docCopy.SaveAs2 sPath & "\" & sFileName & ".doc", 12
    Next i

End Sub

如果您愿意，可以向saveAs2添加更多参数，就像在原始宏中一样。