I found this code that I have to change to work as I need it to
I have this event procedure to open a query that gives me the
approvers based on the amount of the request
so I open the approver Form that has the email addresses I need to go to outlook
Private Sub CmdSendEmail_Click()
Dim stDocName As String
Dim stLinkCriteria As String
stDocName = "Approver"
DoCmd.OpenForm stDocName, , , stLinkCriteria
DoCmd.GoToRecord , , acFirst
DoCmd.MoveSize 2
'call the function to send data to outlook
fctnOutlook , Forms!Approver.[EmailAddress], , "Medco Finance Contracts Admin", "Manual Billing Request. Adjustment Form", "Please review the attached document, Approve or Reject by Email. Please email Medco Finance Contracts Admin the revised Form." & Chr(10) & Chr(10) & "Thank you!" & Chr(10) & Chr(10) & "Adjustment Administrator" & Chr(10) & Chr(10), "Billing Request Adjustment", "S:\Finance\FISD\Adjustments\Snapshots\data.snp", "Approved; Rejected", 2, True
'= original code with no CC's
End Sub
' the function itself allows me to set tracking options in outlook however my
issue is that I need the routine to see the form approver with the field emailaddress
new at functions can anyone help
Set rsNameList = db.OpenRecordset("Form[approver.emailaddress]")
Function fctnOutlook(Optional FromAddr, Optional Addr, Optional CC, Optional BCC, _
Optional Subject, Optional MessageText, Optional Categories, Optional AttachmentPath, Optional Vote As String = vbNullString, _
Optional Urgency As Byte = 1, Optional EditMessage As Boolean = True)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
'Create the Outlook Session
Set objOutlook = CreateObject("Outlook.Application")
'Create the message
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
'Add the Recipients to the message above
With objOutlookMsg
If Not IsMissing(FromAddr) Then
.SentOnBehalfOfName = FromAddr
End If
Dim db As Object
Dim rsNameList As Object
Dim stDocName As String
Set db = CurrentDb
stDocName = "Approver"
'Set rsNameList = db.OpenRecordset("emailaddress")
Set rsNameList = db.OpenRecordset("Form[approver.emailaddress]")
Dim strTo As String
strTo = ""
rsNameList.MoveFirst
While Not rsNameList.EOF
strTo = strTo & rsNameList!Addr & "; "
rsNameList.MoveNext
Wend
'===================================
If Not IsMissing(CC) Then
Set objOutlookRecip = .Recipients.Add(CC)
objOutlookRecip.Type = olCC
End If
If Not IsMissing(BCC) Then
Set objOutlookRecip = .Recipients.Add(BCC)
objOutlookRecip.Type = olBCC
End If
If Not IsMissing(Subject) Then
.Subject = Subject
End If
If Not IsMissing(MessageText) Then
.Body = MessageText
End If
If Not IsMissing(Categories) Then
.Categories = Categories
End If
If Not IsMissing(AttachmentPath) Then
'Check file exists before attaching!
If Len(Dir(AttachmentPath)) > 0 Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
Else
MsgBox "Attachment not found.", vbExclamation
End If
End If
If IsNull(Vote) = False Then
.VotingOptions = Vote
End If
Select Case Urgency
Case 2
.Importance = olImportanceHigh
Case 0
.Importance = olImportanceLow
Case Else
.Importance = olImportanceNormal
End Select
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next
If EditMessage Then
.Display
Else
.Save
.Send
End If
End With
Set objOutlook = Nothing
End Function