Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2562
  • Last Modified:

Ms Access send email using SendObject and file link/hyperlink

Hi,

I have almost got my solution, but I just can't get the final bit.

OK. I have built a Registry and Filing system as part of my DB. The Registry Clerk receives correspondence in and

registers it in my DB and stores any files electronically (in predefined location). Once the registry clerk clicks the

email icon it creates an email with the details of the registry record in eth body of teh text. an example of the

output data is as follows:
'*********************************************
The following email has beent sent by 1 Avn Regt Registry
Document received: 16/04/2009
Document date: 16/04/2009
Classification: Unclassified
Privacy marking: Staff-in-Confidence
Correspondence type: AC 163
Originator: From Originator
Subject: This is the subject of the document


L:\DATA\BRT\1AVNRegt\2009_BRT_Redevelopment\NewPMKeySSourceFiles\IN-2009_0004.txt
'*********************************************
This works nicely; however, I want the file link to be a hyperlink to the file rather than actually attaching the file

itself.  So far no luck. I have tried to set varDocPath as Hyperlink; however, I get an error "Error 91 - Object

Variable or With Block Variable no set"

Problem 2: I also want to include the value of one more field from my form. The issue is it is a combo boxe and I

can't seem to get the value out without an error.

Version 2 of the code below receives the following error: "Error 13 - Type Mismatch"
If I take replace it with

    varMsgText = varMsgText & Chr(10) & "This document has been filed under: " & Me.FileNo(1).Value

then it only provides the file ID, eg 40. RowSource for combo box is shown below. I want the data from the second

column, eg FileNo


I will accept part solutions if people solves each part separately. I will assign points as 60% to file path and 40%

to the combo box value.

Thanks in advance.
Private Sub cmdSendEmail_Click()
'************************************************************************************************
' FUNCTION NAME:        cmdSendEmail_Click
' PURPOSE:              Send Registry Inwards Coorespondence Email
' INPUT PARAMETERS:     Nil
' RETURN:               Email is compiled ready for distribution
'************************************************************************************************
On Error GoTo Err_Handler
    Dim varSubject As String, varMsgText As String, varDocPath As String
    
    'MsgBox Me.FileNo(0).Value
    'MsgBox Me.FileNoAlpha(0).Value
    
    varSubject = "Registry: " & Me.BRTRegoNo.Value & " - " & Me.Subject.Value
    varMsgText = "The following email has beent sent by " & DLookup("SysUnitTitle", "systblSettings", "") & " 
 
Registry"
    varMsgText = varMsgText & Chr(10) & "Document received: " & Me.DateReceived.Value
    varMsgText = varMsgText & Chr(10) & "Document date: " & Me.DocumentDate.Value
    varMsgText = varMsgText & Chr(10) & "Classification: " & Me.SecurityClassification.Value
    varMsgText = varMsgText & Chr(10) & "Privacy marking: " & Me.PrivacyMarking.Value
    varMsgText = varMsgText & Chr(10) & "Correspondence type: " & Me.CorrespondenceType.Value
    varMsgText = varMsgText & Chr(10) & "Originator: " & Me.Originator.Value
    varMsgText = varMsgText & Chr(10) & "Subject: " & Me.Subject.Value & Chr(10) & Chr(10) & Chr(10)
    varDocPath = DLookup("ImportLinkRegistryIn", "systblSettings", "") & Me.BRTRegoNo.Value & Me.DocumentType.Value
    DoCmd.SendObject acSendNoObject, , acFormatHTML, , , , varSubject, varMsgText & varDocPath
    
Exit_Handler:
        Exit Sub
Err_Handler:
        MsgBox "Error " & Err.Number & " - " & Err.Description, vbExclamation, "cmdSendEmail_Click()"
End Sub
 
'********************** VERSION 2 ***********************
 
Private Sub cmdSendEmail_Click()
'************************************************************************************************
' FUNCTION NAME:        cmdSendEmail_Click
' PURPOSE:              Send Registry Inwards Coorespondence Email
' INPUT PARAMETERS:     Nil
' RETURN:               Email is compiled ready for distribution
'************************************************************************************************
On Error GoTo Err_Handler
    Dim varSubject As String, varMsgText As String, varDocPath As Hyperlink
    
    'MsgBox Me.FileNo(0).Value
    'MsgBox Me.FileNoAlpha(0).Value
    
    varSubject = "Registry: " & Me.BRTRegoNo.Value & " - " & Me.Subject.Value
    varMsgText = "The following email has beent sent by " & DLookup("SysUnitTitle", "systblSettings", "") & " 
 
Registry"
    varMsgText = varMsgText & Chr(10) & "Document received: " & Me.DateReceived.Value
    varMsgText = varMsgText & Chr(10) & "Document date: " & Me.DocumentDate.Value
    varMsgText = varMsgText & Chr(10) & "Classification: " & Me.SecurityClassification.Value
    varMsgText = varMsgText & Chr(10) & "Privacy marking: " & Me.PrivacyMarking.Value
    varMsgText = varMsgText & Chr(10) & "Correspondence type: " & Me.CorrespondenceType.Value
    varMsgText = varMsgText & Chr(10) & "Originator: " & Me.Originator.Value
    varMsgText = varMsgText & Chr(10) & "Subject: " & Me.Subject.Value & Chr(10) & Chr(10) & Chr(10)
    varMsgText = varMsgText & Chr(10) & "This document has been filed under: " & Me.FileNo(1).Value
    varDocPath = DLookup("ImportLinkRegistryIn", "systblSettings", "") & Me.BRTRegoNo.Value & Me.DocumentType.Value
    DoCmd.SendObject acSendNoObject, , acFormatHTML, , , , varSubject, varMsgText & varDocPath
    
Exit_Handler:
        Exit Sub
Err_Handler:
        MsgBox "Error " & Err.Number & " - " & Err.Description, vbExclamation, "cmdSendEmail_Click()"
End Sub
 
'*************** combobox Row Source
 
SELECT tblRegistrySubjectiveFileList.FileID, [PriNo] & "-" & [SecNo] & "-" & [TertNo] AS FileNo, [Primary] & " - " & 
 
[Secondary] & " - " & [Tertiary] AS FileDescr FROM tblRegistrySubjectiveFileList ORDER BY 
 
tblRegistrySubjectiveFileList.PriNo, tblRegistrySubjectiveFileList.SecNo, tblRegistrySubjectiveFileList.TertNo; 
 
'****************Preferred final order of Code (with amendments as required)
Private Sub cmdSendEmail_Click()
'************************************************************************************************
' FUNCTION NAME:        cmdSendEmail_Click
' PURPOSE:              Send Registry Inwards Coorespondence Email
' INPUT PARAMETERS:     Nil
' RETURN:               Email is compiled ready for distribution
'************************************************************************************************
On Error GoTo Err_Handler
    Dim varSubject As String, varMsgText As String, varDocPath As String
    
    'MsgBox Me.FileNo(0).Value
    'MsgBox Me.FileNoAlpha(0).Value
    
    varSubject = "Registry: " & Me.BRTRegoNo.Value & " - " & Me.Subject.Value
    varMsgText = "The following email has beent sent by " & DLookup("SysUnitTitle", "systblSettings", "") & " 
 
Registry"
    varMsgText = varMsgText & Chr(10) & "Document received: " & Me.DateReceived.Value
    varMsgText = varMsgText & Chr(10) & "Document date: " & Me.DocumentDate.Value
    varMsgText = varMsgText & Chr(10) & "Classification: " & Me.SecurityClassification.Value
    varMsgText = varMsgText & Chr(10) & "Privacy marking: " & Me.PrivacyMarking.Value
    varMsgText = varMsgText & Chr(10) & "Correspondence type: " & Me.CorrespondenceType.Value
    varMsgText = varMsgText & Chr(10) & "Originator: " & Me.Originator.Value
    varMsgText = varMsgText & Chr(10) & "Subject: " & Me.Subject.Value
    varMsgText = varMsgText & Chr(10) & "This document has been filed under: " & Me.FileNo.Value & Chr(10)
    varMsgText = varMsgText & Chr(10) & "The file can be accessed by clicking the link below:" & Chr(10)
    varDocPath = DLookup("ImportLinkRegistryIn", "systblSettings", "") & Me.BRTRegoNo.Value & Me.DocumentType.Value
    DoCmd.SendObject acSendNoObject, , acFormatHTML, , , , varSubject, varMsgText & varDocPath
    
Exit_Handler:
        Exit Sub
Err_Handler:
        MsgBox "Error " & Err.Number & " - " & Err.Description, vbExclamation, "cmdSendEmail_Click()"
End Sub

Open in new window

0
Kev
Asked:
Kev
  • 3
  • 3
2 Solutions
 
Jeffrey CoachmanMIS LiasonCommented:
budorat,

Unfortunately, in order to have a File Path display, and act as a Hyperlink in the Body of an email you cannot use "SendObject".
SendObject Does not support HTML Hyperlinks in the message body, only text.
You will have to create an email object in code.
Then you will have to use the:  .HTMLBody  property to insert the Hyperlink.

Here is the full code:

'----------------------------------------------
Dim objOutlook          As Outlook.Application
Dim objOutlookMsg       As Outlook.MailItem
Dim objOutlookRecip     As Outlook.Recipient
Dim objOutlookAttach    As Outlook.Attachment


' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
    With objOutlookMsg
        ' Add the To recipient(s) to the message. Substitute
        ' your names here.
        Set objOutlookRecip = .Recipients.Add("SomeBody@WhoKnows.Com")
        objOutlookRecip.Type = olTo
        ' Add the CC recipient(s) to the message.
        'Set objOutlookRecip = .Recipients.Add("CC Recipient Name")
        'objOutlookRecip.Type = olCC
        ' Set the Subject, Body, and Importance of the message.
        .Subject = "This is an Automation test with Microsoft Outlook"
        'Email Body text.
        '.Body = "This is a Test Email"

    'Use this to send the Email using the HTML Format
    .HTMLBody = "<a href='C:\YourFolder\YourFile.txt'> C:\YourFolder\YourFile.txt</a>"

        '.Importance = olImportanceHigh  'High importance
       
        'Add attachments to the message.(Add as many attachments as you need here.)
        'Set objOutlookAttach = .Attachments.Add("C:\Earth.jpg")

        'Delivery Reciepts and Read Reciepts
        '.OriginatorDeliveryReportRequested
        '.ReadReceiptRequested

        ' Resolve each Recipient's name.
        For Each objOutlookRecip In .Recipients
            If Not objOutlookRecip.Resolve Then
                objOutlookMsg.Display
            End If
        Next
       
        'Send email without viewing it.
        '.Send
       
        'Dispay email before sending.
        .Display
   
    End With

'Cleanup Code
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
Set objOutlookRecip = Nothing
Set objOutlookAttach = Nothing
'------------------------------------


(Note: You may have to add a reference to the Outlook Object Library in your VBA editor)

I am sure you can see how you would insert your email variables into this code as well.

;-)

JeffCoachman
0
 
Jeffrey CoachmanMIS LiasonCommented:
As far as the combobox code is concerned, ...try this:

    Me.FileNo.Column(1)
   

;-)

JeffCoachman
0
 
KevAuthor Commented:
Boag2000,

Just having a look now to apply to my DB. Will let you know how I go.

Jeff,

Thanks. I knew I was close ... lol. It works. I will accept your solution as part of the two once I get the first bit working.

Thanks guys as always.
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
KevAuthor Commented:
Hi Guys,

Sorry it has taken so long to accept your answers. They both worked very well.

I have provided the final code I came up with based on your help to assist other users who may happen accross this question in the future.

Cheers

Kev
Private Sub cmdSendRegistry_Click()
'************************************************************************************************
' FUNCTION NAME:        cmdSendEmail_Click
' PURPOSE:              Send Registry Inwards Correspondence Email
' INPUT PARAMETERS:     Nil
' RETURN:               Email is compiled ready for distribution
'************************************************************************************************
On Error GoTo Err_Handler
    
    Dim objOutlook As Outlook.Application, objOutlookMsg As Outlook.MailItem
    Dim objOutlookRecip As Outlook.Recipient, objOutlookAttach As Outlook.Attachment
    Dim varSubject As String, varMsgBody As String, varDocPath As String, vardocPath2 As String
    
    'Set email subject line
    varSubject = "Registry: " & Me.BRTRegoNo.Value & " - " & Me.Subject.Value
    
    'Set email message body
    varMsgBody = "The following email has been sent by " & DLookup("SysUnitTitle", "systblSettings", "") & " Registry"
    varMsgBody = varMsgBody & "<br />" & "Registered No: " & Me.BRTRegoNo.Value
    varMsgBody = varMsgBody & "<br />" & "Subject: " & Me.Subject.Value
    varMsgBody = varMsgBody & "<br />" & "Action addressee(s): " & Me.ActionAddressee.Value
    varMsgBody = varMsgBody & "<br />" & "Info addressee(s): " & Me.InfoAddressee.Value
    varMsgBody = varMsgBody & "<br />" & "Document date: " & Me.DocumentDate.Value
    varMsgBody = varMsgBody & "<br />" & "Classification: " & Me.SecurityClassification.Value
    varMsgBody = varMsgBody & "<br />" & "Privacy marking: " & Me.PrivacyMarking.Value
    varMsgBody = varMsgBody & "<br />" & "Correspondence type: " & Me.CorrespondenceType.Value
    varMsgBody = varMsgBody & "<br />" & "Originator: " & Me.Originator.Value
    varMsgBody = varMsgBody & "<br />" & "This document has been filed under: " & Me.FileNo.Column(1) & " (" & Me.FileNo.Column(2) & ")" & "</p>"
    
    'Set document file path link
    varDocPath = DLookup("ImportLinkRegistryOut", "systblSettings", "") & Me.BRTRegoNo.Value & Me.DocumentType.Value
    vardocPath2 = "<a href='" & varDocPath & "'> Click here for file</a>"
 
    ' Create the Outlook session.
    Set objOutlook = CreateObject("Outlook.Application")
 
    ' Create the message.
    Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
    With objOutlookMsg
    
        ' Set the Subject, Body, and Importance of the message.
        .Subject = varSubject
        .HTMLBody = varMsgBody & vardocPath2
        .Importance = olImportanceHigh  'High importance
    
        If Me.NoFileAttach = False Then
            'Add attachments to the message.(Add as many attachments as you need here.)
            Set objOutlookAttach = .Attachments.Add(varDocPath)
        End If
        
        'Delivery Reciepts and Read Reciepts
        '.OriginatorDeliveryReportRequested
        '.ReadReceiptRequested
        
        ' Resolve each Recipient's name.
        For Each objOutlookRecip In .Recipients
            If Not objOutlookRecip.Resolve Then
                objOutlookMsg.Display
            End If
        Next
    
        'Dispay email before sending.
        .Display
 
    End With
 
    'Cleanup Code
    Set objOutlookMsg = Nothing
    Set objOutlook = Nothing
    Set objOutlookRecip = Nothing
    Set objOutlookAttach = Nothing
 
Exit_Handler:
        Exit Sub
Err_Handler:
        MsgBox "Error " & Err.Number & " - " & Err.Description, vbExclamation, "cmdSendRegistry_Click()"
End Sub
 
Private Sub cmdSendRegistry_Click()
'************************************************************************************************
' FUNCTION NAME:        cmdSendEmail_Click
' PURPOSE:              Send Registry Inwards Correspondence Email
' INPUT PARAMETERS:     Nil
' RETURN:               Email is compiled ready for distribution
'************************************************************************************************
On Error GoTo Err_Handler
    
    Dim objOutlook As Outlook.Application, objOutlookMsg As Outlook.MailItem
    Dim objOutlookRecip As Outlook.Recipient, objOutlookAttach As Outlook.Attachment
    Dim varSubject As String, varMsgBody As String, varDocPath As String
    
    'Set email subject line
    varSubject = "Registry: " & Me.BRTRegoNo.Value & " - " & Me.Subject.Value
    
    'Set email message body
    varMsgBody = "The following email has been sent by " & DLookup("SysUnitTitle", "systblSettings", "") & " Registry"
    varMsgBody = varMsgBody & "<br />" & "Registered No: " & Me.BRTRegoNo.Value
    varMsgBody = varMsgBody & "<br />" & "Subject: " & Me.Subject.Value
    varMsgBody = varMsgBody & "<br />" & "Document received: " & Me.DateReceived.Value
    varMsgBody = varMsgBody & "<br />" & "Document date: " & Me.DocumentDate.Value
    varMsgBody = varMsgBody & "<br />" & "Classification: " & Me.SecurityClassification.Value
    varMsgBody = varMsgBody & "<br />" & "Privacy marking: " & Me.PrivacyMarking.Value
    varMsgBody = varMsgBody & "<br />" & "Correspondence type: " & Me.CorrespondenceType.Value
    varMsgBody = varMsgBody & "<br />" & "Originator: " & Me.Originator.Value
    varMsgBody = varMsgBody & "<br />" & "This document has been filed under: " & Me.FileNo.Column(1) & " (" & Me.FileNo.Column(2) & ")" & "</p>"
    
    'Set document file path link
    varDocPath = DLookup("ImportLinkRegistryIn", "systblSettings", "") & Me.BRTRegoNo.Value & Me.DocumentType.Value
    varDocPath = "<a href='" & varDocPath & "'> Click here for file</a>"
 
    ' Create the Outlook session.
    Set objOutlook = CreateObject("Outlook.Application")
 
    ' Create the message.
    Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
    With objOutlookMsg
    
        ' Set the Subject, Body, and Importance of the message.
        .Subject = varSubject
        .HTMLBody = varMsgBody & varDocPath
        .Importance = olImportanceHigh  'High importance
        
        'Add attachments to the message.(Add as many attachments as you need here.)
        'Set objOutlookAttach = .Attachments.Add(varDocPath)
        
        'Delivery Reciepts and Read Reciepts
        '.OriginatorDeliveryReportRequested
        '.ReadReceiptRequested
        
        ' Resolve each Recipient's name.
        For Each objOutlookRecip In .Recipients
            If Not objOutlookRecip.Resolve Then
                objOutlookMsg.Display
            End If
        Next
    
        'Dispay email before sending.
        .Display
 
    End With
 
    'Cleanup Code
    Set objOutlookMsg = Nothing
    Set objOutlook = Nothing
    Set objOutlookRecip = Nothing
    Set objOutlookAttach = Nothing
 
Exit_Handler:
        Exit Sub
Err_Handler:
        MsgBox "Error " & Err.Number & " - " & Err.Description, vbExclamation, "cmdSendRegistry_Click()"
End Sub

Open in new window

0
 
KevAuthor Commented:
As always.... excellent suggestions and solutions to my questions.
0
 
Jeffrey CoachmanMIS LiasonCommented:
;-)
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 3
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now