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 7:42 PM

All replies

  • This forum is for questions about Visual Basic in Visual Studio. For questions about VBA, try posting in the VBA Forum

    Having said that, it looks like the problem may be that you are trying to access one more Item than actually exists (the first item is probably Item(0)). Try changing the loop to

    For i = 0 To DraftTriggers.Items.Count - 1

    • Edited by Blackwood Tuesday, May 5, 2015 8:52 PM Add possible solution
    Tuesday, May 5, 2015 8:49 PM
  • Thank you Blackwood.  I did try your suggested but got a different error - "array out of bounds".  I will post in the appropriate forum.  Thank you for your help!

    Kim

    Tuesday, May 5, 2015 9:32 PM
  • I have not read the entire code block but would suggest that you check if the Items property of DraftTriggers has any items, if it does and you get an bounds error try starting the For with 1 rather than 0.

    Please remember to mark the replies as answers if they help and unmark them if they provide no help, this will help others who are looking for solutions to the same or similar problem. Contact via my webpage under my profile but do not reply to forum questions.

    Tuesday, May 5, 2015 10:36 PM
  • Hi KimWinnie,

    According to the description, you are developing with Microsoft Project. I would to move it to Project Customization and Programming forum.

    The reason why we recommend posting appropriately is you will get the most qualified pool of respondents, and other partners who read the forums regularly can either share their knowledge or learn from your interaction with us.

    Thanks for your understanding.

    Regards & Fei


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Thursday, May 7, 2015 1:58 AM
  • Hi,

    Firstly, what value does DraftTriggers.Items.Count have?

    Secondly, does the following work?

    Dim Itm as Object

    or

    Dim Itm as Outlook.Item        if you have a reference to Outlook set

    For each Itm in DraftTriggers.Items


    Rod Gill
    Author of the one and only Project VBA Book
    www.project-systems.co.nz

    Friday, May 8, 2015 8:01 AM
    Moderator