Here's a sample of code that I have used for interacting with MS Project
within Excel VBA. Of course, this is code that is going back some time and
I have tightened down on my coding practices since that time.
Dim MSProj As MSProject.Application, NextTime As Date
Public APTLWS As Worksheet, APTLWB As Workbook, bolPrjCls As Boolean
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Function TestTransferData(PF As String)
Dim O As Byte ', PF As String
Application.StatusBar = "Opening Project"
O = OpenProjFile(PF)
DoEvents
If O = 0 Then
MsgBox PF & " did not open properly.(Startup)", 48
TestTransferData = 0
Exit Function
End If
Application.StatusBar = "Opening " & PF
O = FindProjWindows(PF)
If O = 0 Then
TestTransferData = 1
MSProj.FileExit (pjDoNotSave)
Exit Function
End If
TestTransferData = 1
Application.StatusBar = "Filtering and Copying " & PF
O = FilterAllTasks
DoEvents
If O = 0 Then
MsgBox PF & " did not open properly.(Proj)", 48
TestTransferData = 0
Exit Function
ElseIf O = 2 Then
TestTransferData = 1
GoTo CloseApp
End If
Application.StatusBar = "Pasting Data"
PasteResults
CloseApp:
Application.StatusBar = "Closing " & PF
MSProj.DisplayAlerts = False
MSProj.FileCloseAll (pjDoNotSave)
DoEvents
MSProj.FileExit (pjDoNotSave)
DoEvents
Set MSProj = Nothing
DoEvents
Sleep (5000)
Application.StatusBar = False
End Function
Function OpenProjFile(PF As String)
StartProject
DoEvents
On Error GoTo ErrHandle
MSProj.Alerts (False)
MSProj.DisplayAlerts = False
Application.DisplayAlerts = False
Application.StatusBar = "Opening " & PF
MSProj.FileOpen Name:=ThisWorkbook.Path & "\" & PF,
OpenPool:=pjPoolAndSharers
DoEvents
'MSProj.DisplayAlerts = True
OpenProjFile = 1
Exit Function
ErrHandle:
OpenProjFile = 0
Set MSProj = Nothing
End Function
Function FindProjWindows(PF As String)
Dim wd As Window, I As Byte, W As Byte, O As Byte
O = 0
W = MSProj.Windows.Count
If W = 1 Then
FindProjWindows = 0
Exit Function
End If
For I = 1 To W
If InStr(1, MSProj.Windows(I).Caption, "Project", 0) > 0 Then
MSProj.Windows(I).Activate
O = 1
End If
Next
If O = 0 Then
O = (ActiveWindow.Index Mod 2) + 1
MSProj.Windows(O).Activate
End If
FindProjWindows = 1
End Function
Sub InsProjNotFound()
If bolPrjCls Then
VBA.SendKeys "{TAB}{TAB}{SPACE}", False
End If
End Sub
--
Thanks,
Ronald R. Dodge, Jr.
Production Statistician
Master MOUS 2000