Debugging Code

I am trying to debug a piece of VB code in outlook.  The FORM & MODULE code is shown below.  The problem is as follows;

I had a macro written by BlueDevilFan which allowed me to compose an email select the categories of person that I wished to send to and thereafter dedupe any people in more than one category where more than one category was selected and then send the email.

However I have since migrated to a new computer and copied the code but have the problems as detailed below.

1. When I press tools>macro>macros>then press 'run' - firstly I don't get the opportunity to select the categories that I wish to mail to.
2. After pressing 'run I get the following code;

'Run Time Error 424' Object Required

3. When I press 'debug' the following line is highlighted in YELLOW;

objForm.Show

Can anyone help please?

Thanks

FORM CODE

Private Sub cmdSelect_Click()
    Dim intIndex As Integer
    For intIndex = 0 To lbCategory.ListCount - 1
        If lbCategory.Selected(intIndex) Then
            strCategory = strCategory & lbCategory.List(intIndex) & ","
        End If
    Next
    strCategory = Mid(strCategory, 1, Len(strCategory) - 1)
    Unload Me
End Sub

'Private Sub cmdSelect_Click()
'    Me.Hide
'End Sub

Private Sub UserForm_Initialize()
    lbCategory.AddItem "Artists"
    lbCategory.AddItem "VIP"
    lbCategory.AddItem "Very VIP"
    lbCategory.AddItem "LBH"
    lbCategory.AddItem "Online Gallery"
    lbCategory.AddItem "Galleries"
    lbCategory.AddItem "Studios"
    lbCategory.AddItem "Artist - Ceramicist"
    lbCategory.AddItem "Artist - Digital"
    lbCategory.AddItem "Artist - Film"
    lbCategory.AddItem "Artist - Glass"
    lbCategory.AddItem "Artist - Graphic"
    lbCategory.AddItem "Artist - Illustrator"
    lbCategory.AddItem "Artist - Jewelery"
    lbCategory.AddItem "Artist - Painter"
    lbCategory.AddItem "Artist - Photographer"
    lbCategory.AddItem "Artist - Printmaker"
    lbCategory.AddItem "Artist - Sculptor"
    lbCategory.AddItem "Artist - Textiles"
    lbCategory.AddItem "Artist - Theatre"
    lbCategory.AddItem "Artist - Writer"
    lbCategory.AddItem "DHS"
    lbCategory.AddItem "Johnsons"
    lbCategory.AddItem "catA"
    lbCategory.AddItem "catB"
    lbCategory.AddItem "catC"
End Sub

MODULE CODE
'Macro Begins Here
'New code prefaced with PGM

'This variable has to be declared outside of a procedure at the top of the module for it be visible to the category dialog-box.
Public strCategory As String

Sub SendMessageToAllContacts()
    Dim objFolder As Object, _
        objContact As Object, _
        objMessage As Object, _
        objTempMsg As Object, _
        objForm As New frmSelectCat2, _
        arrCategories As Variant, _
        arrSelectedCats As Variant, _
        lngCounter As Long, _
        intCounter As Integer, _
        bolCatOK As Boolean

    objForm.Show
    If Trim(strCategory) = "" Then
        MsgBox "No category selection made.  Aborting!", vbCritical
        Exit Sub
    Else
        arrSelectedCats = Split(strCategory, ",")
    End If

    'Grab the message open onscreen
    Set objMessage = Application.ActiveInspector.CurrentItem
    'Open the Contacts folder
    Set objFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
    'Loop through all the entries in the Contacts folder
    For Each objContact In objFolder.Items
    bolCatOK = False
        'If the item is a contact and not a distribution list
        If objContact.Class = olContact Then
            'Check contact for category
            arrCategories = Split(IIf(objContact.Categories = "", "jhSis7du", objContact.Categories), ",")
            For lngCounter = LBound(arrCategories) To UBound(arrCategories)
                For intCounter = LBound(arrSelectedCats) To UBound(arrSelectedCats)
                    If Trim(arrCategories(lngCounter)) = arrSelectedCats(intCounter) Then
                        bolCatOK = True
                        Exit For
                    End If
                Next
                If bolCatOK Then
                    Exit For
                End If
            Next
            If bolCatOK Then

                'Make a copy of the onscreen message
                Set objTempMsg = objMessage.Copy
                objTempMsg.Display
                'If the first address field isn't empty
                If objContact.Email1Address <> "" Then
                    'Address the message to the first address
                    objTempMsg.Recipients.Add objContact.Email1Address
                End If
                'If the second address field isn't empty
                If objContact.Email2Address <> "" Then
                    'Address the message to the second address
                    objTempMsg.Recipients.Add objContact.Email2Address
                End If
                'If the third address field isn't empty
                If objContact.Email3Address <> "" Then
                    'Address the message to the third address
                    objTempMsg.Recipients.Add objContact.Email3Address
                End If
                'If the message has a recipient address
                If objTempMsg.Recipients.Count > 0 Then
                    'Resolve the address/addresses
                    objTempMsg.Recipients.ResolveAll
                    'Send the message
                    objTempMsg.Send
                End If
                Set objTempMsg = Nothing
            End If

        'PGM
        End If

    Next
    'Destroy all objects
    Set objTempMsg = Nothing
    Set objMessage = Nothing
    Set objContact = Nothing
    Set objFolder = Nothing
End Sub
'Code Ends Here

THE PROBLEM


Start Free Trial