iankerry
Registered User.
- Local time
- Today, 17:22
- 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
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