filtering an access form from Outlook

iankerry

Registered User.
Local time
Today, 05:12
Joined
Aug 10, 2005
Messages
190
Some while ago I tried to get this routine working (thanks to Darbid on this forum). I feel like I was close and this morning I have tried again.

This is what I want to achieve - having highlighted an email address in Outlook, I click a button (macro) and it filters a form i have open to the person with that email address.

I feel like i am close but not quite there!

Here is my code (agian thanks to Darbid) so far:

Sub emTool()


On Error GoTo Err_SendEmailToAccess

Dim appAccess As Object 'late binding of the MSAccess object
Dim objDBase As Object 'late binding of LuTTool MDB
Dim out_Exp As Outlook.Explorer
Dim out_Sel As Outlook.Selection
Dim out_mail As Outlook.MailItem
Dim out_Rec As Outlook.Recipient
Dim fs As Object
Dim out_emailAddress As String


'get the active explorer
Set out_Exp = Application.ActiveExplorer

If out_Exp.CurrentFolder.WebViewOn = False Then
Set out_Sel = out_Exp.Selection
Else
MsgBox "selection wrong type"
Set out_Exp = Nothing
Exit Sub
End If

'only chosen one item b
If out_Sel.Count > 1 Then
MsgBox "Please only select one item"
Exit Sub
Else
If out_Sel.Count = 0 Then
MsgBox "Please select somthing"
Exit Sub
End If
End If

'is it an email
If Not out_Sel.Item(1).Class = olMail Then
MsgBox "Please only choose email items"
Exit Sub
End If


'is it encrypted
On Error Resume Next

Set out_mail = out_Sel.Item(1)

If Err.Number = 13 Then
Err.Clear
MsgBox "Email is encrypted"
Exit Sub
End If



'For Each out_Rec In out_Rec.SenderEmailAddress

out_emailAddress = out_mail.SenderEmailAddress

'Next


Set appAccess = GetObject(, "Access.Application")

If Err.Number = 429 Then
Err.Clear
MsgBox "Access is closed, please start access"
Exit Sub
End If

Set objDBase = appAccess.CurrentDb


If Dir(objDBase.Name) = "flicks.accdb" Then
appAccess.Run "ian", out_emailAddress
End If

Set appAccess = Nothing
Set objDBase = Nothing


Exit_SendEmailToAccess:
Exit Sub

Err_SendEmailToAccess:
MsgBox "error"
Resume Exit_SendEmailToAccess

End Sub



The routine picks up the email address of the sender ok (out_emailAddress)
but when it comes to the next line

appAccess.Run "ian", out_emailAddress (where ian is a module in access)
nothing happens.

Would someone take a look through my code and see if you can tell where i am going wrong?

many thanks.

ian
 

Users who are viewing this thread

Back
Top Bottom