Looping through outlook appointments in access (1 Viewer)

[stephen1990]

Hi,

I have a problem that I can't find a solution for anywhere.
I have a form that on load populates the form with a contacts details take from outlook, it also has 3 list boxes on it 2 of which show emails sent to and received from the selected contact, and the 3rd is meant to show any appointments where the contacts was a recipient/attendee.
the code should loop through each appointment and then loop through the recipients in each appointment and if the contact is included in the appointment it should add the details to the list box. however when the code runs i get and type mis match error.

the code is:
Private Sub Form_Load()
Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objConatactFolder As Outlook.MAPIFolder
Dim objAppFolder, objMailFolder As Outlook.MAPIFolder
Dim objItems, objAppItems, objMailItems As Outlook.Items
Dim objCont As Outlook.ContactItem
Dim objApp As Outlook.AppointmentItem
Dim objMail As Outlook.MailItem
Dim Args As Variant

Dim strName, strMail, srtTxtStart, strTxtDate, strTxtEnd As String
Args = Split(Me.OpenArgs, ";")

strName = Args(0)
strMail = Args(1)

Set objOL = New Outlook.Application
Set objNS = objOL.GetNamespace("MAPI")
Set objContactFolder = objNS.GetDefaultFolder(olFolderContacts)
Set objItems = objContactFolder.Items.Restrict("[Full Name] = '" & strName & "' and [Mail1Address] = '" & strMail & "'")

For Each objCont In objItems
With objCont
txtFirst = .FirstName
txtLast = .LastName
txtComp = .CompanyName
txtJob = .JobTitle
txtMail = .Mail1Address
txtWork = .BusinessTelephoneNumber
txtMob = .MobileTelephoneNumber
End With
Next
Dim strFull As String

strFull = txtFirst & " " & txtLast
Set objAppFolder = objNS.GetDefaultFolder(olFolderCalendar)
Set objAppItems = objAppFolder.Items
Dim x, j As Integer
/*****This is the section of code that doesnt work
' For Each objApp In objAppItems
' With objApp
' x = .Recipients.Count
' j = 0
' If x > 0 Then
' j = j + 1
' Do Until j = x
' If .Recipients.Item(j).Address = txtMail.Value Then
' lstApps.AddItem (.Start & ";" & .Subject)
' j = j + 1
' Else
' j = j + 1
' End If
'Loop

' End If
'End With
'Next
/****************************
Set objMailFolder = objNS.GetDefaultFolder(olFolderInbox)
Set objMailItems = objMailFolder.Items.Restrict("[From] = '" & strFull & "' or [From] = '" & txtMail & "'")

For Each objMail In objMailItems
With objMail
lstMail.AddItem (.SentOn & ";" & .Subject)
End With
Next

Set objMailFolder = objNS.GetDefaultFolder(olFolderSentMail)
Set objMailItems = objMailFolder.Items.Restrict("[To] = '" & strFull & "' or [To] = '" & txtMail & "'")

For Each objMail In objMailItems
With objMail
lstMailTo.AddItem (.SentOn & ";" & .Subject)
End With
Next
End Sub

any suggestions would be much appreciated

Many Thanks

Stephen

p.s i am using OUtlook & Access 2010

 

[spikepl]

Your declarations are messed up - a list of variables followed by As SomeType results in only the last one being of that type, while the rest are variants.

Also, when asking for help on an error it is wise to actually state which specific line gives grief.

Finally, when posting code, use code brackets - Go Advanced -> select code -> press #

 

[stephen1990]

ok, thanks very much, i'll remember that when posting in future

 

[stephen1990]

hi,
ive changes the variable declaration and it does not seemed to of fixed the problem, the code is now:

Private Sub Form_Load()
    Dim objOL As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Dim objConatactFolder As Outlook.MAPIFolder
    Dim objAppFolder As Outlook.MAPIFolder
    Dim objMailFolder As Outlook.MAPIFolder
    Dim objMailItems As Outlook.Items
    Dim objItems  As Outlook.Items
    Dim objAppItems As Outlook.Items
    
    Dim objCont As Outlook.ContactItem
    Dim objAppt As Outlook.AppointmentItem
    Dim objMail As Outlook.MailItem
    Dim Args As Variant

    Dim strName, strMail, srtTxtStart, strTxtDate, strTxtEnd As String
    Args = Split(Me.OpenArgs, ";")
    
    strName = Args(0)
    strMail = Args(1)
    
        Set objOL = New Outlook.Application
        Set objNS = objOL.GetNamespace("MAPI")
        Set objContactFolder = objNS.GetDefaultFolder(olFolderContacts)
        Set objItems = objContactFolder.Items.Restrict("[Full Name] = '" & strName & "' and [Mail1Address] = '" & strMail & "'")
        
    For Each objCont In objItems
        With objCont
        txtFirst = .FirstName
        txtLast = .LastName
        txtComp = .CompanyName
        txtJob = .JobTitle
        txtEmail = .Mail1Address
        txtWork = .BusinessTelephoneNumber
        txtMob = .MobileTelephoneNumber
        End With
    Next
    Dim strFull As String

    strFull = txtFirst & " " & txtLast
    Set objAppFolder = objNS.GetDefaultFolder(olFolderCalendar)
    Set objAppItems = objAppFolder.Items
        Dim x, j As Integer
    For Each objAppt In objAppItems
        With objAppt
           x = .Recipients.Count
           j = 0
           If x > 0 Then
                   j = j + 1
           Do Until j = x
                If .Recipients.Item(j).Address = txtMail.Value Then
                lstApps.AddItem (.Start & ";" & .Subject)
                j = j + 1
                Else
                j = j + 1
                End If
           Loop
              
           End If
        End With
    Next - ERROR OCUURS HERE - TYPE MISMATCH
    
    Set objMailFolder = objNS.GetDefaultFolder(olFolderInbox)
    Set objMailItems = objMailFolder.Items.Restrict("[From] = '" & strFull & "' or [From] = '" & txtMail & "'")
    
    For Each objMail In objMailItems
        With objMail
            lstMail.AddItem (.SentOn & ";" & .Subject)
        End With
    Next
    
    Set objMailFolder = objNS.GetDefaultFolder(olFolderSentMail)
    Set objMailItems = objMailFolder.Items.Restrict("[To] = '" & strFull & "' or [To] = '" & txtMail & "'")
        
    For Each objMail In objMailItems
        With objMail
            lstMailTo.AddItem (.SentOn & ";" & .Subject)
        End With
    Next
End Sub

also when in debug mode when i hover the cursor of .recipient.count its says object variable or with block variable not set

many thanks
stephen

 

[spikepl]

You should always have

Option Explicit

at the top of your code module

 

[stephen1990]

thanks for your reply, i have put that in and still getting the same error in the same place

Thanks

Stephen