MS Project VBA:循环全部打开.MPP，打印PDF

目标：VBA宏，它将在所有打开的项目中循环，应用3个不同的视图，并将它们转换为PDF格式。目前，下面的代码应用了正确的视图（过滤器等），并执行“另存为”，但我必须单击“确定”两次以确认位置并重写现有的。其次，我考虑过使用Set SecondProject=ActiveProject，但是团队中有我们三个人，而且我们拥有的项目数量并不相同。MS Project似乎完全不同，我发现其他应用程序的示例不起作用。为了简化，我将包括下面的一个报告视图，而不是全部3个

主要问题： 1） 如何循环所有打开的项目 2） 如何使其跳过“另存为”中的“确定”步骤（是否有其他打印为PDF的方法）

目前的代码如下：

Dim FirstProject As Project
Dim SecondProject As Project

Dim targetFolder As String

targetFolder=“C:\Users\522842\Desktop\Community Care Transformation\1.可交付成果”

---

循环浏览所有打开的项目并导出为PDF格式（保留项目名称并附加“.PDF”扩展名）的示例：

Option Explicit
Sub test()
    Dim P As Project
    Dim ProjectFullName As String
    Dim PDFname As String
    Dim DotPos As Integer
    For Each P In Projects
        P.Activate
        'Add code here to apply views and filters as required
        ProjectFullName = P.FullName
        DotPos = InStr(ProjectFullName, ".")
        If DotPos > 0 Then ProjectFullName = Left(ProjectFullName, DotPos - 1)
        PDFname = ProjectFullName & ".PDF"
        DocumentExport FileName:=PDFname
    Next P
End Sub   

我们让它工作了（注意对用户特定字段的引用需要修改）

Sub PrintThisFile()

Dim Names As String

Names = ActiveProject.Name                                                                                                                                                 'Read in file name
Names = Replace(Names, ".mpp", "")                                                                                                                                                                      'Get rid of .mpp extension
FilePageSetupPage PaperSize:=pjPaperTabloid
ViewApply Name:="VA Status"                                                                                                                                                                             'Set VA Status View
OutlineShowAllTasks
FilterApply Name:="&All Tasks"                                                                                                                                                                          'Clears existing filter
FilterApply Name:="Active Tasks"                                                                                                                                                                        'Set the Active Filter to prepare the full schedule for printing
DocumentExport FileName:="C:\Users\USERNAME\Desktop\Community Care Transformation\1. Deliverables\" & Names & ".pdf"                                             'Saves the document as a pdf *MUST CHANGE DESTINATION FOLDER ACCORDINGLY
FilterApply Name:="VA 2 Week"                                                                                                                                                                           'Apply the 2 week look ahead view
DocumentExport FileName:="C:\Users\USERNAME\Desktop\Community Care Transformation\1. Deliverables\" & Names & "_Two Week Look Ahead.pdf"       'Saves the 2 week look ahead document as a pdf *MUST CHANGE DESTINATION FOLDER ACCORDINGLY
FilterApply Name:="VA Only Status Due"                                                                                                                                                      'Apply the Only Status Due view
DocumentExport FileName:="C:\Users\USERNAME\Desktop\Community Care Transformation\1. Deliverables\" & Names & "_Due Next Week.pdf"                   'Saves the document as a pdf
ViewApply Name:="VA Status"                                                                                                                                                                             'Reset to VA Status View
FilterApply Name:="&All Tasks"
FilterApply Name:="Active Tasks"
PaneClose           


MsgBox ("Documents have been saved")

End Sub

---

您好，谢谢您使用此选项。运行此选项时的结果是它重命名了MS Project文件，但实际上没有打印为PDF。有什么想法吗？谢谢。

Sub PrintThisFile()

Dim Names As String

Names = ActiveProject.Name                                                                                                                                                 'Read in file name
Names = Replace(Names, ".mpp", "")                                                                                                                                                                      'Get rid of .mpp extension
FilePageSetupPage PaperSize:=pjPaperTabloid
ViewApply Name:="VA Status"                                                                                                                                                                             'Set VA Status View
OutlineShowAllTasks
FilterApply Name:="&All Tasks"                                                                                                                                                                          'Clears existing filter
FilterApply Name:="Active Tasks"                                                                                                                                                                        'Set the Active Filter to prepare the full schedule for printing
DocumentExport FileName:="C:\Users\USERNAME\Desktop\Community Care Transformation\1. Deliverables\" & Names & ".pdf"                                             'Saves the document as a pdf *MUST CHANGE DESTINATION FOLDER ACCORDINGLY
FilterApply Name:="VA 2 Week"                                                                                                                                                                           'Apply the 2 week look ahead view
DocumentExport FileName:="C:\Users\USERNAME\Desktop\Community Care Transformation\1. Deliverables\" & Names & "_Two Week Look Ahead.pdf"       'Saves the 2 week look ahead document as a pdf *MUST CHANGE DESTINATION FOLDER ACCORDINGLY
FilterApply Name:="VA Only Status Due"                                                                                                                                                      'Apply the Only Status Due view
DocumentExport FileName:="C:\Users\USERNAME\Desktop\Community Care Transformation\1. Deliverables\" & Names & "_Due Next Week.pdf"                   'Saves the document as a pdf
ViewApply Name:="VA Status"                                                                                                                                                                             'Reset to VA Status View
FilterApply Name:="&All Tasks"
FilterApply Name:="Active Tasks"
PaneClose           


MsgBox ("Documents have been saved")

End Sub