Link to home
Start Free TrialLog in
Avatar of Kev
KevFlag for Australia

asked on

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

ASKER CERTIFIED SOLUTION
Avatar of Jeffrey Coachman
Jeffrey Coachman
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Kev

ASKER

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.
Avatar of Kev

ASKER

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

Avatar of Kev

ASKER

As always.... excellent suggestions and solutions to my questions.