By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
434,921 Members | 1,305 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 434,921 IT Pros & Developers. It's quick & easy.

Access Function for Outlook_From Form

P: 1
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
Feb 1 '08 #1
Share this question for a faster answer!
Share on Google+

Post your reply

Sign in to post your reply or Sign up for a free account.