Update Outlook Distro List in VBA

[petec556]

I am trying to have Access add email addresses to an Outlook Distribution list. Currently, I have Access set up to send to multiple addresses, however the email won't send encrypted to some of the members. I have found that I can have Access send to an already existing distro list, and everything works.

I have been trying to find the VBA needed to make this happen, and have run into some snags. My VBA window does not have the Tools/References option available.

Thanks for any help!

 

[sneuberg]

Doesn't have the Microsoft Office Object Library reference or doesn't even have the menu item: Tool/References?

 

[petec556]

The "References" option is not selectable, so I would say the whole thing. I don't have permissions to make changes to any software because it is a Government system.

 

[sneuberg]

I don't have permissions to make changes to any software because it is a Government system.

I don't understand. Are you trying to make changes to the software in spite of that?

 

[petec556]

I am trying to get Access to add email addresses from a table to an Outlook distro list. Some of my users are very computer illiterate, and I find it easiest to have them update the table through a form I have built. My current VBA will send to a specific set of addresses. I don't know enough about VBA to figure out how to tell it what to do, and haven't had any luck finding the code through google.
My current code is:

Public Sub eMailDistro_Click()
Dim subject As String
Dim body As String
Dim EmailAddress As String
Dim rs As Object
Dim strSQL As String
Dim count As Integer
Dim recount As Integer
'set up sql string that opens query for selected group
strSQL = ("SELECT [strRecipientEmail] FROM [tblEmailTemp];")
'set recordset to sql string to open qry
Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
' move to last record to ensure record count is correct
rs.MoveLast
'move back to first record
rs.MoveFirst
'set variable recount to number of records
recount = rs.RecordCount
'start for next loop
For count = 1 To recount
'MsgBox rs![strEmailAddress]
EmailAddress = EmailAddress & rs![strRecipientEmail] & ";"
'move to next recordset
rs.MoveNext
'increment the for/next counter
Next count
'remove the spare ";" from end of last email address
EmailAddress = Left(EmailAddress, (Len(EmailAddress) - 1))
'MsgBox recount & "" & Email Address
'close the recordset
rs.Close
'set it to nothing
Set rs = Nothing
'put info in subject line
subject = "Funeral Honors Request for:"
'put info in body
body = "Please contact the funeral home, verify details & email us back when done. Send your response to ***EMAIL ADDRESS REMOVED***
'send the email
DoCmd.SendObject , , , EmailAddress, , , subject, body, True
EmailAddress = ""
'end
End Sub

My apologies if my explinations are confusing, I'm in the process of trying to teach myself VBA.

 

[petec556]

Here is the code I used to get it to send to a distro list that is already existing in Outlook.


Private Sub DistroTest2_Click()

Dim subject As String
Dim body As String
Dim DistroAddress As String
Dim rs As Object
Dim strSQL As String
Dim count As Integer
Dim recount As Integer
'set up sql string that opens query for selected group
strSQL = ("SELECT [strRecipientEmail] FROM [tblEmailTemp];")
'set recordset to sql string to open qry
Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
' move to last record to ensure record count is correct
rs.MoveLast
'move back to first record
rs.MoveFirst
'set variable recount to number of records
recount = rs.RecordCount
'start for next loop
For count = 1 To recount
'MsgBox rs![strEmailAddress]
DistroAddress = DistroAddress & rs![strRecipientEmail] & ";"
'move to next recordset
rs.MoveNext
'increment the for/next counter
Next count
'remove the spare ";" from end of last email address
DistroAddress = Left(DistroAddress, (Len(DistroAddress) - 1))
'MsgBox recount & "" & Email Address
'close the recordset
rs.Close
'set it to nothing
Set rs = Nothing
'put info in subject line
subject = "Funeral Honors Request for:"
'put info in body
body = "Please contact the funeral home, verify details & email us back when done. Send your response to EMAIL ADDRESS REMOVED."
'send the email
DoCmd.SendObject , , , DistroAddress, , , subject, body, True
DistroAddress = ""
'end
End Sub