是否有VBA代码可以查看Enterprise Project 2013文件是否在打开之前签出?

Dav*_*ker 7 vba ms-project microsoft-project-vba

试图帮助我们的Project 2013用户使用一些VBA代码,我们已经找到了一个我们无法找到答案来查找是否使用VBA在我们的PWA服务器上签出Project 2013文件的答案.它们基本上有一个Projects列表,在一个Project文件中设置为任务,VBA代码循环遍历任务列表以运行FileOpenEx,执行一些更改,然后关闭它.但是,需要能够在列表中的每个项目上运行FileOpenEx之前检查项目文件是否已签出.这里有一个我想要的样本,并不是我想要的.

SelectBeginning
While ActiveCell.CellColor <> pjBlack
   fname = "<>\" & ActiveCell.Task.Name
   justname = ActiveCell.Task.Name

   On Error Resume Next
   If Application.Projects.CanCheckOut(fname) Then '<--This does not work correctly, not checking Enterprise Projects?
       FileOpenEx Name:=fname, ReadOnly=false
       'Do Some stuff
       FileCloseEx Save:=pjSave, CheckIn:=True
       FileSave
   Else
      MsgBox (justname & " can not be checked out")
   End If

   SelectCell Row:=1
Wend
Run Code Online (Sandbox Code Playgroud)

如果有人有一个更好的解决方案,一个简单的方法来检查这个,或另一个解决方法,以确定是否通过VBA代码检查企业项目,请告诉我.谢谢!

Dav*_*ker 1

我们创建了一个适合规划者的解决方法,但我们必须以任何一种方式打开文件。这样做是以只读模式打开文件,然后尝试在没有警报的情况下检查它。之后,如果我将其签出(这意味着没有其他人签出),它将设置 j=0 并保存,然后继续进行下一个项目。如果其他人签出了它,那么它将转到“错误处理程序”,它告诉项目关闭而不保存,并将文件名保存在稍后返回的字符串中。

SelectBeginning
While ActiveCell.CellColor <> pjBlack
   fname = "<>\" & ActiveCell.Task.Name
   justname = ActiveCell.Task.Name
   FileOpenEx Name:=fname, ReadOnly=true
   Set ProjToOpen = Application.Projects.Application.ActiveProject
   j = 1
   Application.DisplayAlerts = False
   ProjToOpen.Checkout Project
   Application.DisplayAlerts = True

   If Not Application.IsCheckedOut(ProjToOpen.Name) Then
      GoTo errorhandler
   End If

   'Perform actions here

   j = 0
   FileCloseEx Save:=pjSave, CheckIn:=True
   FileSave
errorhandler: 
   If Not j = 0 Then
      ReDim Preserve skippedfiles(0 to skipped) As String
      skippedfiles(skipped) = justname
      skipped = skipped + 1
      ProjToOpen.Application.FileCloseEx Save:=pjDoNotSave
      GoTo GoToNextProj
   End If

GoToNextProj:
   SelectCell Row:=1

Wend
msgstring = Join(skippedfiles(), vbCr)

MsgBox "Here are the files that were already checked out and therefore not changed: " & vbCr & msgstring
Run Code Online (Sandbox Code Playgroud)