Hi all, I could use some help.
I am running the below VBA script in MSProject 2007 w/Office 2013. I know this script used to work, but it may have been in Project 2010 w/Office 2013. I am receiving Run-time error 438 at the line--->BOLDED. Any and all help would be appreciated.
Thank you!
Kim,
------------------------------
TaskName = Left(ActiveProject.Application.ActiveCell.Task.Name, 150)
ProjectName = "Sandy "
Phase = " CUTOVER "
If Trim(UCase(ActiveProject.Application.ActiveCell.Task.Text29)) = "N" Or Trim(ActiveProject.Application.ActiveCell.Task.Text29) = "" Then
strFind = ProjectName & ActiveProject.Application.ActiveCell.Task.Text15 & Phase & "TASK TRIGGER - " & ActiveProject.Application.ActiveCell.Task.Text1 & " - " & TaskName
strFind1 = ActiveProject.Application.ActiveCell.Task.Text1
ElseIf Trim(UCase(ActiveProject.Application.ActiveCell.Task.Text29)) = "Y" Then
strFind = ProjectName & ActiveProject.Application.ActiveCell.Task.Text15 & Phase & "PAPER TASK TRIGGER - " & ActiveProject.Application.ActiveCell.Task.Text1 & " - " & TaskName
strFind1 = ActiveProject.Application.ActiveCell.Task.Text1
Else
strFind = "Invalid entry"
strFind1 = ActiveProject.Application.ActiveCell.Task.Text1
End If
If Len(strFind) > 255 Then
strFind = Left(strFind, 255)
End If
Dim myItems As Object 'Outlook.Items
Dim myItem As Object
Dim mySentItems As Object
Set myOlapp = CreateObject("Outlook.Application")
Set myNameSpace = myOlapp.GetNamespace("MAPI")
'Set myFolder = myNameSpace.GetDefaultFolder(olFolderDrafts)
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set mySentFolder = myNameSpace.GetDefaultFolder(olFolderSentMail)
Set mySentItems = mySentFolder.Items
strParentName = myInbox.Parent
Set myMB = myNameSpace.Folders(strParentName)
Set CycleName = myMB.Folders("Production Cutover")
Set CycleName1 = CycleName.Folders("00 Production Triggers")
Set DraftTriggers = CycleName1.Folders("0 Prod Draft Task Triggers")
Set InProcTriggers = CycleName1.Folders("1 Prod In Progress Triggers")
For i = 1 To DraftTriggers.Items.Count
-----> If DraftTriggers.Items.Item(i) = strFind Then
DraftTriggers.Items(i).Display
'myOlapp.Controls("Send").Enabled = False
If (MsgBox("Would you like to send the trigger?" & vbCrLf & vbCrLf & _
"Click 'Yes' to Continue or 'No' to Cancel.", vbInformation + vbYesNo, "Prompt") = vbYes) Then
If InStr(1, strFind, "'") = 0 Then
DraftTriggers.Items(i).Subject = strFind
Else
DraftTriggers.Items(i).Subject = Replace(strFind, "'", "")
strFind = Replace(strFind, "'", "")
End If
DraftTriggers.Items(i).Send
Select Case ActiveProject.Application.ActiveCell.Task.Text1
Case Is = strFind1
ActiveProject.Application.SelectRow
Font Color:=pjBlue
End Select
ActiveProject.Application.ActiveCell.Task.PercentComplete = 1
strMsgVar = "found"
Excel.Application.Wait Now + TimeValue("00:00:09")
For k = 1 To mySentItems.Count
If mySentItems.Item(k) = strFind Then
With mySentItems.Item(k)
If .Class = olMail Then
.ReminderSet = True
.ReminderTime = DateAdd("n", ActiveProject.Application.ActiveCell.Task.Duration, Now)
.Save
End If
End With
strFoundSts = "Yes"
mySentItems.Item(k).Move InProcTriggers
Exit For
End If
Next
Exit For
Else
Exit Sub
End If
End If
Next
If strMsgVar = "found" Then
If strFoundSts = "Yes" Then
MsgBox "Message Sent & Moved to In Progress folder, Color Updated to Blue, % Updated to 1%."
Else
MsgBox "Please move the Sent message Manually to In Progress folder, Message sent, Color Updated to Blue, % Updated to 1%, "
End If
Else
MsgBox "Message Not Found !"
End If
End Sub
