Option Explicit
Sub UpdateProjects()
Dim iPR As Integer, pj As Object, r As Range, tsk As Object
Dim sSHIP As String, sITEM As String, iPCT As Integer, ans
ans = MsgBox("Are you ready?", vbYesNo)
If ans = vbNo Then Exit Sub
'[b]OpenFiles opens 4 Project files[/b]
OpenFiles
Set pj = New MSProject.Application
For iPR = 1 To 4
'[b]process the 4 open Project files[/b]
With pj.Projects(iPR)
FilterInput ProjectName(.Name)
For Each r In [tINPUT[Ship Number]].SpecialCells(xlCellTypeVisible)
sSHIP = r.Value
sITEM = Intersect(r.EntireRow, [tINPUT[item]])
iPCT = Intersect(r.EntireRow, [tINPUT[Percent completed]])
'[b]loop thru each Task for This Project[/b]
For Each tsk In .Tasks
With tsk
'[b]in This Task assign Text1, Text2 & PercentWorkComplete
'[highlight]I used the Watch Window to DISCOVER which Task Property I needed to manipulate[/highlight][/b]
If Format(.Text1, "000000") = sSHIP Then
If Format(.Text2, "00") = sITEM Then
.PercentWorkComplete = iPCT
Exit For
End If
End If
End With
Next
Next
End With
Next
wsINPUT.ShowAllData
Set pj = Nothing
End Sub
Sub test()
MsgBox ProjectName("MIRABEL SHIP STATUS_206L_123456.mpp")
End Sub
Function ProjectName(FILE As String) As String
Dim a, i As Integer
a = Split(FILE, "_")
For i = 0 To UBound(a) - 1
ProjectName = ProjectName & a(i) & "_"
Next
ProjectName = Left(ProjectName, Len(ProjectName) - 1)
End Function
Sub FilterInput(CRIT As String)
'[b]wsInput is the Sheet Object for my Structured Table named tINPUT[/b]
wsINPUT.ListObjects("tINPUT").Range.AutoFilter _
Field:=[tINPUT[#headers]].Find("Project").Column, Criteria1:=CRIT
End Sub
Sub OpenFiles()
Dim a, oFSO As Object, oFile As Object, i As Integer, sPath As String, sEXT As String
Dim sSP, pj As Object
Set pj = New MSProject.Application
pj.Visible = True
Set oFSO = CreateObject("Scripting.FileSystemObject")
' sPath = "\\dfwsrv222\public\SkipM\Stephanie_MS_Project"
sPath = "R:\Dept2b\MSTSCHED\Bennett, Stephanie"
For Each oFile In oFSO.GetFolder(sPath).Files
sEXT = Split(oFile.Name, ".")(UBound(Split(oFile.Name, ".")))
If sEXT Like "mpp*" Then
pj.FileOpen oFile.Path
End If
Next
Set pj = Nothing
Set oFSO = Nothing
End Sub