View Single Post
  #4 (permalink)  
Old April 15th, 2005, 07:41 AM
mmcdonal mmcdonal is offline
Friend of Wrox
 
Join Date: Mar 2004
Posts: 3,069
Thanks: 0
Thanked 10 Times in 10 Posts
Default

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
Reply With Quote