Access VBA Outlook .To error

[reggiete]

Hello All,

I have the below code in a module to call outlook. The problem i am having is the .To part. The outlook dialogue does pop up but all of the emails located in the Query1 do not show up in the To box in outlook. The .CC shows all the emails for the manager but .to box only shows 1 email

Set oOutlook = GetObject(, "Outlook.Application")
If oOutlook Is Nothing Then
Set oOutlook = New Outlook.Application
End If
Set oEmailItem = oOutlook.CreateItem(olMailItem)
With oEmailItem
Set rs = CurrentDb.OpenRecordset("SELECT * FROM Query1")
If rs.RecordCount > 0 Then
rs.MoveFirst
Do Until rs.EOF
If IsNull(rs!Email) Then
rs.MoveNext
Else
AssociateEmail = customerEmail & rs!Email & ";"
ManagerEmail = ManagerEmail & rs!ManagerEmail & ";"
.To = AssociateEmail
.CC = ManagerEmail
rs.MoveNext
End If
Loop
End If
Set rs = Nothing
.Importance = olImportanceHigh
.Subject = "Action Needed: OPUS - User Access Review - by Date"
'.Attachments.Add FilePath'

 

[pbaldy]

You aren't including the value of the variable in the string, so you'll just end up with the last one. And customerEmail doesn't appear to be defined or set anywhere. Was that supposed to be AssociateEmail?

 

[reggiete]

sorry didnt post full code

Sub EmailMemo()
Dim FilePath As String
Dim FileName As String
Dim oOutlook As Outlook.Application
Dim oEmailItem As MailItem
Dim CompUser As String
Dim Path As String
Dim myDate As String
Dim todayDate As String
Dim rs As Recordset
Dim customerEmail As String
Dim ManagerEmail As String
'todayDate = Format(Date, "MMDDYYYY")'
'FileName = Me.ManagerName & "_NonFS User Report_" & todayDate & ""'
'FilePath = "C:\temp\" & FileName & ".xls"'
'DoCmd.OutputTo acOutputQuery, "Qryrpt_NonFSOutlookRpt", acFormatXLS, FilePath'

Set oOutlook = GetObject(, "Outlook.Application")
If oOutlook Is Nothing Then
Set oOutlook = New Outlook.Application
End If
Set oEmailItem = oOutlook.CreateItem(olMailItem)
With oEmailItem
Set rs = CurrentDb.OpenRecordset("Query1")
If rs.RecordCount <> 0 Then
rs.MoveFirst
Do Until rs.EOF
If IsNull(rs!Email) Then
rs.MoveNext
Else
AssociateEmail = customerEmail & rs!Email & ";"
ManagerEmail = ManagerEmail & rs!ManagerEmail & ";"
.To = AssociateEmail
.CC = ManagerEmail
rs.MoveNext
End If
Loop
End If
Set rs = Nothing
.Importance = olImportanceHigh
.Subject = "Action Needed: OPUS - User Access Review - by Date"
'.Attachments.Add FilePath'
.Body = "Hello," & vbNewLine & vbNewLine & " I am reviewing Opus access for users outside of an AAL. Please see the attached report for users with OPUS Access. If this access is still required to perform daily job functions, please respond with a business justification to maintain access within 3 days from the date of this email. If access is not required, or no response is received, we will submit the request to remove the Opus roles." & vbNewLine & vbNewLine & "Please send back the attached report with business justification for each OPUS access permissions"

.Display

End With
Set oEmailItem = Nothing
Set oOutlook = Nothing
'AppActivate oOutlook
End Sub

 

[Minty]

As Paul said - AssociateEmail isn't defined and then you are setting it to CustomerEmail which is not set to a value anywhere

 

[pbaldy]

Again, you've mixed variables.

 

[pbaldy]

I guess I'll get out of the way.

 

[Minty]

I guess I'll get out of the way.

Sorry Paul - I didn't see your reply initially (Not concentrating very hard...)

 

[reggiete]

Ahh i see my error. THanks Pbaldy !!!! simple and i was stressing over this all morning

 

[pbaldy]

Happy to help!