cheat a little, Outlook will delete duplicate address, although it is better
to get it right. But I would not build a form and query, instead just feed
outlook the information and let it do the work. Although below looks
confusing at first it is actually quite easy and below provides diferent
emails and different people as needed. I (what is the word) benchmarked off
of the Microsoft example and tweeked it as suggestions came in. I'm sure it
isn't perfect but it more than served the pupose for what we needed. As I
was under time constrants I never cleaned it up but should give you a
jumping off point. Use a SQL statement to feed it from your query. Water
is fine, come on in.
Option Compare Database
Option Explicit
Function SendMessage(DisplayMsg As Boolean, Optional AttachmentPath)
On Error Resume Next
Dim objOutlook As Outlook.Application 'Outlook junk
Dim objOutlookMsg As Outlook.MailItem 'Outlook junk
Dim objOutlookRecip As Outlook.Recipient 'Outlook junk
Dim objOutlookAttach As Outlook.Attachment 'Outlook junk
Dim Part1 As String 'Broke down string for ease of usage
Dim Part2 As String 'Broke down string for ease of usage
Dim Part3 As String 'Broke down string for ease of usage
Dim Part4 As String 'Broke down string for ease of usage
Dim DirApproval As String 'Broke down string for ease of usage
Dim TypeRun As String 'Send correct string depending on run type
Dim ReqFirstName As String 'Broke down names for parsing in message
Dim ReqLastName As String 'Broke down names for parsing in message
Dim POCFirstName As String 'Broke down names for parsing in message
Dim POCLastName As String 'Broke down names for parsing in message
Dim OprFirstName As String 'Broke down names for parsing in message
Dim OprLastName As String 'Broke down names for parsing in message
Dim TRNFirstName As String 'Broke down names for parsing in message
Dim TRNLastName As String 'Broke down names for parsing in message
Dim DirFirstName As String 'Broke down names for parsing in message
Dim DirLastName As String 'Broke down names for parsing in message
Dim CarbonCopy As String 'Used for testing who recieves email
Dim SendtoWho As String 'Used for testing who recieves email
Dim NoMail As Integer 'Warn user of action to take if request has
no mail
Dim VehStuff As String 'Figure out how to present vehicle data in
memo
Dim OprSentence As String 'Figure out how to present operator sentence
If Forms!F_TabRequests.Combo11 > "" Then
'Create vehicle portion of message depending on if vehicle assigned yet
VehStuff = "We have assigned " & Forms!F_TabRequests.Combo11 _
& " a " & Forms!F_TabRequests.BodyStyle & ", " &
Forms!F_TabRequests.Capacity _
& ", " & Forms!F_TabRequests.CapacityUnit & " to your mission. "
Else
VehStuff = "We have not assigned a vehicle to this mission yet. "
End If
RunCommand acCmdSaveRecord 'Make sure record safe before calling mail
system
'NoMail = MsgBox(" Warning" & vbCrLf &
vbCrLf _
& " If requester doesn't have email you will have " & vbCrLf & vbCrLf
_
& "to print this message and send it through distribution", vbOKOnly,
"Warning")
'Put data file fields into english for the memo
If Forms!F_TabRequests.DirWho > "" Then
'Parse directorate approval and make string
DirFirstName = Right$(Forms!F_TabRequests.DirWho,
Len(Forms!F_TabRequests.DirWho) _
- InStr(1, Forms!F_TabRequests.DirWho, ",") - 1)
DirLastName = Left$(Forms!F_TabRequests.DirWho, _
InStr(1, Forms!F_TabRequests.DirWho, ",") - 1)
DirApproval = " and " & DirFirstName & " " & DirLastName & " at " _
& Forms!F_TabRequests.DirectoratePhone & " was your directorates
approval authority"
End If
SendtoWho = Forms!F_TabRequests.TransRequestBy
'Set primary email address
If IsNull(Forms!F_TabRequests.TransRequestBy) And Not
IsNull(Forms!F_TabRequests.POC) _
Then
'If missing requestor use poc
SendtoWho = Forms!F_TabRequests.POC
ElseIf Forms!F_TabRequests.TransRequestBy <> Forms!F_TabRequests.POC
Then
CarbonCopy = Forms!F_TabRequests.POC
'If we have both requestor and poc send each a copy
End If
' Now lets figure out what type run string to insert
If Forms!F_TabRequests.DropOff = True Then
TypeRun = " You requested to be dropped off and left at your
destination. "
ElseIf Forms!F_TabRequests.U_Drive_It = True Then
TypeRun = " Your request is for a U-Drive-It vehicle. "
ElseIf Forms!F_TabRequests.RemainWith = True Then
TypeRun = " You Requested an operator to wait and return with you. "
ElseIf Forms!F_TabRequests.DropReturn = True Then
TypeRun = " You Requested the operator to drop you off and return to
pick you up at " _
& Format(Forms!F_TabRequests.DropReturnTime, "Hh:Nn") & ". "
End If
If IsNull(Forms!F_TabRequests.Operator) Then
'If operator blank insert TBD so email reads ok
Forms!F_TabRequests.Operator = "TBD"
End If
If IsNull(Forms!F_TabRequests.Remarks) Then ' If no remarks insert None
so email reads ok
Forms!F_TabRequests.Remarks = "None"
End If
' Fix email names up so read correctly in memo part.
' This may require work if display names change format.
ReqFirstName = Right$(Forms!F_TabRequests.TransRequestBy, _
Len(Forms!F_TabRequests.TransRequestBy) _
- InStr(1, Forms!F_TabRequests.TransRequestBy, ",") - 1)
ReqLastName = Left$(Forms!F_TabRequests.TransRequestBy, _
InStr(1, Forms!F_TabRequests.TransRequestBy, ",") - 1)
POCFirstName = Right$(Forms!F_TabRequests.POC, _
Len(Forms!F_TabRequests.POC) - InStr(1, Forms!F_TabRequests.POC, ",") -
1)
POCLastName = Left$(Forms!F_TabRequests.POC, InStr(1,
Forms!F_TabRequests.POC, ",") - 1)
'If no requester throw poc in it for email
If IsNull(Forms!F_TabRequests.TransRequestBy) And Not
IsNull(Forms!F_TabRequests.POC) Then
ReqLastName = POCLastName
ReqFirstName = POCFirstName
End If
'If we have an operator parse it to correct format for memo or don't
bother to parse TBD
If Forms!F_TabRequests.Operator <> "TBD" Then
OprFirstName = Right$(Forms!F_TabRequests.Operator, _
Len(Forms!F_TabRequests.Operator) - InStr(1,
Forms!F_TabRequests.Operator, ",") - 1)
OprLastName = Left$(Forms!F_TabRequests.Operator, _
InStr(1, Forms!F_TabRequests.Operator, ",") - 1)
Else
OprLastName = Forms!F_TabRequests.Operator
End If
If OprLastName = "TBD" Then
OprSentence = "."
Else
OprSentence = ", who has completed the Defensive Drivers Course."
End If
'Now we parse the trans approval authority name so memo reads correct
TRNFirstName = Right$(Forms!F_TabRequests.J4TransWho, _
Len(Forms!F_TabRequests.J4TransWho) - InStr(1,
Forms!F_TabRequests.J4TransWho, ",") - 1)
TRNLastName = Left$(Forms!F_TabRequests.J4TransWho, _
InStr(1, Forms!F_TabRequests.J4TransWho, ",") - 1)
'Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
'Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
'Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(SendtoWho)
objOutlookRecip.Type = olTo
'Add the CC recipient(s) to the message.
If CarbonCopy > "" Then
'If Forms!F_TabRequests.TransRequestBy <> CarbonCopy And Not
IsNull(CarbonCopy) Then
Set objOutlookRecip = .Recipients.Add(CarbonCopy)
objOutlookRecip.Type = olCC
End If
'If we have dir approval name add them to cc list
If Forms!F_TabRequests.DirWho > "" Then
Set objOutlookRecip = .Recipients.Add(Forms!F_TabRequests.DirWho)
objOutlookRecip.Type = olCC
End If
'Add the BCC recipient(s) to the message.
'Set objOutlookRecip = .Recipients.Add("Andrew Fuller")
'objOutlookRecip.Type = olBCC
'Set the Subject, Body, and Importance of the message.
.Subject = "Automated Transportation Request Confirmation, " _
& Forms!F_TabRequests.RequestNumber
'Build the message body
Part1 = "From: Transportation Division J-4" _
& " " _
& Format(Forms!F_TabRequests.DateSubmitted, "d mmm yyyy") & vbCrLf &
vbCrLf & _
"Subject: Transportation Request " & Forms!F_TabRequests.RequestNumber
_
& vbCrLf & vbCrLf & _
"To: " & Forms!F_TabRequests.Directorate & ", " & ReqFirstName & " " &
ReqLastName & _
vbCrLf & vbCrLf & _
"This is an automated transportation request confirmation. " & _
"The information contained in this memo was extracted from our
Transportation " & _
"Asset Tracking file. Please confirm all items are " & _
"correct and maintain this letter for your records. If you find an
error please contact" & _
" transportation schedulers immediately to make corrections. " & vbCrLf
& vbCrLf & _
"You requested a " & Forms!F_TabRequests.TypeVehicle & ", and expect to
move " _
& Forms!F_TabRequests.CapacityMoved & ", " &
Forms!F_TabRequests.CapacityUnitReq & _
"(s) to accomplish your mission. " & VehStuff
Part2 = "You requested the support for " _
& Format(Forms!F_TabRequests.DateRequired, "d mmm yyyy") & _
" at " & Format(Forms!F_TabRequests.PickupTime, "Hh:Nn") & " with a
pickup " & _
"location of " & Forms!F_TabRequests.PickupLocation _
& ". Your primary destination will be " _
& Forms!F_TabRequests.Destination & " (see remarks below for " & _
"special instructions). You are expected to complete your mission by "
_
& Format(Forms!F_TabRequests.Est_CompleteDate, "d mmm yyyy") & " at " &
_
"" & Format(Forms!F_TabRequests.Est_CompleteTime, "Hh:Nn") _
& ". Please contact us immediately if you expect changes to this
schedule as " & _
"other customers may be waiting for your vehicle or driver. " _
& "If changes occur during your mission contact the Transportation " _
& "Dispatcher at (202) 260-0507. The dispatcher will have " & _
"control once this mission is in progress. Driver will report to " _
& Forms!F_TabRequests.ReportTo & ". " & vbCrLf & vbCrLf
Part3 = "We currently show the operator as " & OprFirstName & " " _
& OprLastName & OprSentence & " Your point of contact for this request
is, " _
& POCFirstName & " " & POCLastName & " in " _
& Forms!F_TabRequests.POCPosition & ", duty phone " & _
"" & Forms!F_TabRequests.POCPhone & ". " & TRNFirstName & " " &
TRNLastName & " at " _
& Forms!F_TabRequests.J4TransPhone & " of Transportation Division
approved this " & _
"request" & DirApproval & ". The members of the Transportation Division
are " _
& "pleased to provide you the best transportation service we possibly "
& _
"can. Please let us know if there is any way we may improve support or
" _
& "if you were pleased with " & _
"our performance. Remember to BUCKLE UP! It's the law and we want to "
_
& "serve you in the future. Thank you. " & vbCrLf & vbCrLf
Part4 = "Additional remarks: " & Forms!F_TabRequests.Remarks
'Assemble Message
.Body = Part1 & Part2 & TypeRun & Part3 & Part4
'High importance
.Importance = olImportanceHigh
'Add attachments to the message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If
'Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next
'Should we display the message before sending?
If DisplayMsg Then
.Display
Else
.Send
End If
End With
'Free memory
Set objOutlook = Nothing
End Function
MMesarch said:
Yes the records are truly duplicate....duplicate in the sense that the
names
and addresses are the same....that is the contact id for the person.
And yes I checked the SQL and it is SELECT DISTINCT
Here is the SQL for the qry that the 2nd form uses
SELECT DISTINCTROW [Data Sources].DataSource, tblcontacts.LastName,
tblcontacts.FirstName, [Data Sources].DataSourceID
FROM tblcontacts INNER JOIN ([Data Sources] INNER JOIN tblReference ON
[Data
Sources].DataSourceID = tblReference.DataSourceID) ON
tblcontacts.ContactID =
tblReference.ContactID
ORDER BY [Data Sources].DataSource, tblcontacts.LastName,
tblcontacts.FirstName;
But since it is the visual basic that is setting limit of what is scene is
there something there that need to be set withthat??
Here is the visual basic code that grabs the list parameters:
Dim stDocName As String
Dim stLinkCriteria As String
Dim varItem As Variant
Dim numberselected As Integer
stDocName = "fromMarkTotal"
stLinkCriteria = ""
numberselected = 1
For Each varItem In Me.List0.ItemsSelected
If numberselected = Me.List0.ItemsSelected.Count Then
stLinkCriteria = stLinkCriteria & "[DataSourceID]=" &
Me.List0.Column(0, varItem)
