This should work to package data from your database and send it. If you need to get user info like email addresses as well, send me some table structure and we can rewrite the code.
'=====
Private Sub btnSendEmail_Click()
Dim stSubject As String
Dim stName As String
Dim stSender As String
Dim stMessage As String
Dim stHelpDesk As String
Dim stFinished As String
Dim rs As ADODB.Recordset
Dim stSQL As String
Dim stAsset As String
Dim stSN As String
Dim stList As String
stSQL = "Select * from qryAssets Where UserID = " & Me.UserID
stSubject = "Exiting Employee"
stSender = "
[email protected]"
stName = Me.FirstName & " " & Me.LastName & " (" & Me.LOGIN_NAME & ")"
stMessage = "Please retrieve the following items from "
stHelpDesk = "
[email protected];HelpDeskManager@OurDomain. gov;
[email protected]"
stFinished = "The HelpDesk has been notified."
Set rs = New ADODB.Recordset
rs.Open stSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
Do Until rs.EOF
stAsset = rs!AssetCategory
stSN = rs!SerialNumber
stList = stList & vbCrLf & stAsset & " (SN:" & stSN & ")"
rs.MoveNext
Loop
Const cdoSendUsingPickup = 1 'Send message using the local SMTP service pickup directory.
Const cdoSendUsingPort = 2 'Send the message using the network (SMTP over the network).
Const cdoAnonymous = 0 'Do not authenticate
Const cdoBasic = 1 'basic (clear-text) authentication
Const cdoNTLM = 2 'NTLM
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = stSubject
objMessage.Sender = stSender
objMessage.To = stHelpDesk
objMessage.TextBody = stMessage & stName & ":" & vbCrLf & stList
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'Name or IP of Remote SMTP Server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.aoc.gov"
'Type of authentication, NONE, Basic (Base64 encoded), NTLM
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
'Your UserID on the SMTP server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = "****"
'Your password on the SMTP server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "****"
'Server port (typically 25)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
'Use SSL for the connection (False or True)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
objMessage.Configuration.Fields.Update
'==End remote SMTP server configuration section==
objMessage.Send
MsgBox stFinished
End Sub
'=====
mmcdonal