Kev
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_Redeve lopment\Ne wPMKeySSou rceFiles\I N-2009_000 4.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.
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_
'*************************
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
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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
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
ASKER
As always.... excellent suggestions and solutions to my questions.
;-)
ASKER
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.