none
Project VBA script receiving error "Run-time error 438: Object doesn't support this property or method" RRS feed

  • Question

  • 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

    Tuesday, May 5, 2015 9:35 PM