【问题标题】:MS Word 2013 VBA Macro FunctionMS Word 2013 VBA 宏功能
【发布时间】:2015-12-14 17:21:42
【问题描述】:

以下 VBA 代码不会将打开的文档保存到活动“我的文档”文件夹下的子文件夹中。该代码是从 App_DocumentBeforeClose 调用的,它在执行时不会抛出错误标志或处理失败通知。所有代码和保存位置字符串的构建都按照预期的方式工作 - 打开的文档不会保存到“我的文档”子文件夹中。文件本身是存储在 SDHC 芯片上的工作副本——这可能是问题所在吗?我检查了文件夹权限,并且子文件夹的“只读”属性已关闭。

Public Sub SaveToTwoLocations()
Dim Res
Dim oDoc As Document, SourceFile As String, DestinationFile As String
Dim strBackUpPath As String, fDialog As FileDialog, Reps, DocName As String

If Right(ActiveWindow.Caption, 4) = "ode]" Then
    DocName = Left(ActiveWindow.Caption, Len(ActiveWindow.Caption) - 21)
ElseIf Right(ActiveWindow.Caption, 5) = ".docx" Then
    DocName = Left(ActiveWindow.Caption, Len(ActiveWindow.Caption) - 5)
End If

On Error GoTo CanceledByUser

Res = MsgBox("Save Source File?", vbQuestion + vbYesNo, "Save Original Prior to Back-Up Interrogative")
If Res = vbYes Then
    Application.ActiveDocument.Save
End If

If GetSetting("My_Books", DocName, "Save_2") = "" Then
    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    With fDialog
        .Title = "Select Folder to Save The Copy To & Click Ok"
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewList
        If .Show <> -1 Then
            MsgBox "Canceled By user", , "Save To Two Locatiions"
            Exit Sub
        End If
        strBackUpPath = fDialog.SelectedItems.Item(1) & "\"
        Res = MsgBox("Save File To Selected 'SaveTo' Location?", vbQuestion + vbYesNo, "'SaveTo' Interrogative")
        If Res = vbYes Then
            SaveSetting "My_Books", DocName, "Save_2", strBackUpPath
            strBackUpPath = strBackUpPath & DocName & ".docx"
            Application.ActiveDocument.SaveAs2 (strBackUpPath)
        Else
            Exit Sub
        End If
    End With

Else

    strBackUpPath = GetSetting("My_Books", DocName, "Save_2")
    Res = MsgBox("Save This Document To: " & strBackUpPath & "?", vbQuestion + vbYesNo, "Two Location Save Interrogative")
    If Res = vbYes Then
        If Right(ActiveDocument.Name, 1) = "x" Then
            Application.ActiveDocument.SaveAs2 (strBackUpPath = strBackUpPath & DocName & ".docx")
        Else
            MsgBox "Non-docx Doument File Save Error", vbCritical, "2nd Location File Save Error"
            GoTo CanceledByUser
        End If
    Else
        Set fDialog = Application.FileDialog(msoFileDialogSaveAs)
        With fDialog
            .Title = "Select Folder to Save The Copy To & Click Ok"
            .AllowMultiSelect = False
            .InitialView = msoFileDialogViewList
            If .Show <> -1 Then
                MsgBox "File Save Canceled By User", , "Save To Two Locatiions Canceled"
                Exit Sub
            End If
        End With
    End If

End If

CanceledByUser:
End Sub

【问题讨论】:

  • 这一行看起来错误(在参数列表中尝试赋值):Application.ActiveDocument.SaveAs2 (strBackUpPath = strBackUpPath & DocName & ".docx")
  • Tim Williams - 字符串构建过程必须考虑到文档名称在 [ElseIf Right(ActiveWindow.Caption, 5) = ".docx" Then] 处被截断的事实,以允许匹配注册表项标识先前存储的保存到位置 - 这使我能够区分当前正在处理的多个文档。
  • 是“.doc”和“.docx”文档都出现问题,还是只出现在前者?因为您保存“.doc”文档的方式(在没有先前设置的情况下)显然是错误的。 (如果有先前的设置,请根据@bibadia 更正代码)
  • 是的,这两种类型都适用 - 抱歉,我之前没有想到,但是,作为测试,我修改了代码以将文件作为 .docx 保存到“D”驱动器临时文件夹并且它有效,所以问题是不允许宏将文件写入文档文件夹,并且信任中心设置设置为启用所有宏并信任对 VBA 项目对象模型的访问 - 问题是微软,像往常一样.现在我必须想办法解决,因为微软当然没有人知道如何去做。多么典型!
  • 仅供参考,“Microsoft AMIRITE ”在这里没有积分?厘米。

标签: vba ms-word


【解决方案1】:
Application.ActiveDocument.SaveAs2 (strBackUpPath = strBackUpPath & DocName & ".docx")

应该是

Application.ActiveDocument.SaveAs2 strBackUpPath

【讨论】:

  • 代码应该是: Application.ActiveDocument.SaveAs2 (strBackUpPath & DocName & ".docx") 在我的辩护中,我会说微软通常是它自己最大的敌人,原因在其他地方有充分的记录 -至于最初编写的代码,它可以在标准 VB6 中工作,但 VBA 不是 VB6。我向蒂姆威廉姆斯表示感谢 - 虽然在技术上不正确,但你让我得到了正确的答案,并且可能是编译器误解了所写的串联。但是出于效率的原因,仍然需要重写的串联。谢谢!
  • 哦,现在我已经纠正了我的错误,它工作得很好!
【解决方案2】:

代码应该是: Application.ActiveDocument.SaveAs2 (strBackUpPath & DocName & ".docx") 在我的辩护中,我会说微软通常是它自己最大的敌人,原因在其他地方有充分的记录 - 至于代码最初编写的,它可以在标准 VB6 中工作,但 VBA 不是 VB6。我向蒂姆威廉姆斯表示感谢 - 虽然在技术上不正确,但你让我得到了正确的答案,并且可能是编译器误解了所写的串联。但是出于效率和紧凑性的原因,仍然需要重写的串联。哦,现在我已经纠正了我的错误,它工作得很好!谢谢大家!

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2013-05-09
    • 1970-01-01
    • 2015-04-05
    • 2022-07-27
    • 1970-01-01
    • 2011-11-29
    相关资源
    最近更新 更多