New to functions. Found the outlook function in search to add tracking to email from Access to Outlook.
Figured syntax for field from form. Issue form can have anywhere from 1 record to multiple records up to nine.
for 1 to 9 duplicates last email addr if <9
Have tried using for next loop which semi works but somehow need to incorporate a counter in form built in counter field called Count
but I can not seem to add it to existing code without failing at that member.
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 stDocName As String
Dim stLinkCriteria As String
'Dim Count As long
stDocName = "Approver"
For i = 1 To 2
If Not IsMissing(Addr) Then
Set objOutlookRecip = .Recipients.Add(Addr)
objOutlookRecip.Type = olTo
End If
DoCmd.OpenForm stDocName, , , stLinkCriteria
DoCmd.GoToRecord , , acNext
Next i
DoCmd.GoToRecord , , acFirst
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