• 0

VB Script to send emails based off of a SQL table

Asked by hoffmn,

 Share

Question

Neowinian

hoffmn

Posted
Posted

I have created a table in SQL pulling a bunch of information together so I can email a client when a new account is created. I wanted to try to do this through SQL but I don't want to be using our DB to send emails out. That is why I am here. I want to create a VB script that I can set to run as a scheduled task every night which will read my SQL table and shoot an email out to anyone who matches the criteria. First, will this be easy to do using VB? Second, would anyone be willing to help me out? I am familiar with VB.Net but I am a noob at VB scripts. Basically this is what I want to do...

Look at the table and see if there were any accounts created in the previous day. I then want to pull out the new ACCOUNT NAME that was created for them. I want to pull any information stored in EMAIL1, EMAIL2, EMAIL3 and set those addresses as the RECIPIENTS. I then want to have a hard coded subject, and an HTML formatted body that can take fields out of the table and insert them into the body to make it a little more personal.

I appreciate any help I can get.

I originally had the following...

Do While Not objRS.EOF

strServer = "mail.domain.com"
strSender = "test@domain.com" 
strRecipient = email1&";"&email2&";"&email3
strSubject = "Your account has been created"
' strMessage = Taken from "Account Email.docx"
strMessage = "<HTML><BODY><p>Dear "&email1&",<br/><br/>An account has been created.<br/><br/><b>ID:</b><br/>Your account ID is: <b>"&sAMAccountName&"</b><br/>Your Email Address is: <b>"&sAMAccountName&"@domain.com</b><br/>Account Creation Date is <b>"&created&"</BODY></HTML>"

sendMail strServer, strSender, strRecipient, strSubject, strMessage

sub sendMail (server, sndr, rcpt, subj, msg)
    Dim iMsg, iConf, Flds 
    ' Set the visual basic constants as they do not exist within VBScript.
    ' Do not set your smtp server information here.
    Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing"
    Const cdoSendUsingPort = 2
    Const cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
    ' The following field names are not needed, but can be enabled
'     Const cdoSMTPServerPort = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
'     Const cdoSendEmailAddress = "http://schemas.microsoft.com/cdo/configuration/sendemailaddress"
'     Const cdoSendUserReplyEmailAddress = "http://schemas.microsoft.com/cdo/configuration/senduserreplyemailaddress"
'     Const cdoSMTPAuthenticate = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
'     Const cdoBasic = 1
'     Const cdoSendUserName = "http://schemas.microsoft.com/cdo/configuration/sendusername"
'     Const cdoSendPassword = "http://schemas.microsoft.com/cdo/configuration/sendpassword"
'     Const cdoSMTPConnectionTimeout = "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"

    ' Create the CDO connections.
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
    Set Flds = iConf.Fields

     ' SMTP server configuration.
    With Flds
        .Item(cdoSendUsingMethod) = cdoSendUsingPort
        ' Set the SMTP server address here.
        .Item(cdoSMTPServer) = "mail.domain.com"
        ' Optional Fields
'         .Item(cdoSMTPServerPort) = 25
'         .Item(cdoSendEmailAddress) = """MySelf"" <myself@example.com>"
'         .Item(cdoSendUserReplyEmailAddress) = """Another"" <another@example.com>"
'         .Item(cdoSMTPAuthenticate) = cdoBasic
'         .Item(cdoSendUserName) = "domain\username"
'         .Item(cdoSendPassword) = "password"
'         .Item(cdoSMTPConnectionTimeout) = 10
        .Update
    End With

    ' Set the message properties.
    With iMsg
        Set .Configuration = iConf
        .To = rcpt
'         .CC = rcpt
        .From = sndr
        .Subject = subj
    End With

    If InStr(UCase(msg), "<HTML>") Then
        iMsg.HTMLBody = msg
    Else
        iMsg.TextBody = msg
    End If

    ' An attachment can be included.
    'iMsg.AddAttachment Attachment

    ' Send the message.
    iMsg.Send

'move to the next record
    objRS.MoveNext
    Loop

...But when I had this I was getting a syntax error on the sub sendMail line.

I think my main problem is going to be that I want to do multiple passes through the table and send 1 email for each record. Each record is going to have a maximum of three email addresses (email1, email2 and email3). I need to populate the recipient list with those for each record or send 1 email per email1, 2, 3 per record.

I will put the full code below.

Dim strServer
Dim strSender
Dim strRecipient
Dim strSubject
Dim strMessage
Dim oSQLobject
Dim strSQL				'SQL string to access DB
Dim objRS				'Recordset object
Dim objConn				'Connection object
Dim strConn
Dim param1
Dim param2
Dim param3

Set objConn = Server.CreateObject("ADODB.Connection")
Set objRS = Server.CreateObject("ADODB.Recordset")

'The following is the SQL connection string.
strConn.Open "Driver={SQL Server};server=server;database=db;uid=uname;pwd=pword;"

' -- Open the Connection
objConn.Open strConn

Set MyCommand = CreateObject("ADODB.Command")
Set MyCommand.ActiveConnection = MyConnection

'SQL query to get data
strSQL = "SELECT * FROM EmailTest"
'Populate our Recordset with data
set objRS = objConn.Execute (strSQL)

if (objRS.BOF and objRS.EOF) then
        response.write "No new accounts found."
        response.end
End if

'Now output the contents of the Recordset
        objRS.MoveFirst

Do While Not objRS.EOF

strServer = "mail.domain.com"
strSender = "test@domain.com" 
strRecipient = email1&";"&email2&";"&email3
strSubject = "Your account has been created"
' strMessage = Taken from "Account Email.docx"
strMessage = "<HTML><BODY><p>Dear "&email1&",<br/><br/>An account has been created.<br/><br/><b>ID:</b><br/>Your account ID is: <b>"&sAMAccountName&"</b><br/>Your Email Address is: <b>"&sAMAccountName&"@domain.com</b><br/>Account Creation Date is <b>"&created&"</BODY></HTML>"

sendMail strServer, strSender, strRecipient, strSubject, strMessage

sendMail server, sndr, rcpt, subj, msg
    Dim iMsg, iConf, Flds 
    ' Set the visual basic constants as they do not exist within VBScript.
    ' Do not set your smtp server information here.
    Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing"
    Const cdoSendUsingPort = 2
    Const cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
    ' The following field names are not needed, but can be enabled
'     Const cdoSMTPServerPort = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
'     Const cdoSendEmailAddress = "http://schemas.microsoft.com/cdo/configuration/sendemailaddress"
'     Const cdoSendUserReplyEmailAddress = "http://schemas.microsoft.com/cdo/configuration/senduserreplyemailaddress"
'     Const cdoSMTPAuthenticate = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
'     Const cdoBasic = 1
'     Const cdoSendUserName = "http://schemas.microsoft.com/cdo/configuration/sendusername"
'     Const cdoSendPassword = "http://schemas.microsoft.com/cdo/configuration/sendpassword"
'     Const cdoSMTPConnectionTimeout = "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"

    ' Create the CDO connections.
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
    Set Flds = iConf.Fields

    ' SMTP server configuration.
    With Flds
        .Item(cdoSendUsingMethod) = cdoSendUsingPort
        ' Set the SMTP server address here.
        .Item(cdoSMTPServer) = "mail.domain.com"
        ' Optional Fields
'         .Item(cdoSMTPServerPort) = 25
'         .Item(cdoSendEmailAddress) = """MySelf"" <myself@example.com>"
'         .Item(cdoSendUserReplyEmailAddress) = """Another"" <another@example.com>"
'         .Item(cdoSMTPAuthenticate) = cdoBasic
'         .Item(cdoSendUserName) = "domain\username"
'         .Item(cdoSendPassword) = "password"
'         .Item(cdoSMTPConnectionTimeout) = 10
        .Update
    End With

    ' Set the message properties.
    With iMsg
        Set .Configuration = iConf
        .To = rcpt
'         .CC = rcpt
        .From = sndr
        .Subject = subj
    End With

    If InStr(UCase(msg), "<HTML>") Then
        iMsg.HTMLBody = msg
    Else
        iMsg.TextBody = msg
    End If

    ' An attachment can be included.
    'iMsg.AddAttachment Attachment

    ' Send the message.
    iMsg.Send

'move to the next record
    objRS.MoveNext
    Loop

        response.write "</table>"

        objRS.Close
        set objRS = Nothing
        objConn.Close
        set objConn = Nothing

Any help is greatly appreciated.

1 answer to this question

Recommended Posts

This topic is now closed to further replies.
 Share
Go to question listing

  • Recently Browsing   0 members

    • No registered users viewing this page.

  • Posts

    • Microsoft will finally stop shoving Edge down your throat, on one condition

      By David Uzondu · Posted

      Over regulation is bad. That's why the EU is behind the US. But, it's a good thing the EU stepped in, in this case.
    • Microsoft will finally stop shoving Edge down your throat, on one condition

      By David Uzondu · Posted

      Yep
    • Microsoft will finally stop shoving Edge down your throat, on one condition

      By wingliston · Posted

      Thanks to the EU, Windows 11 is now a little more tolerable.
    • Microsoft will finally stop shoving Edge down your throat, on one condition

      By David Uzondu · Posted

      Microsoft will finally stop shoving Edge down your throat, on one condition by David Uzondu Avid Windows users must be familiar with the dirty tactics Microsoft employs to push its Edge browser. It's a song as old as time; remember when Internet Explorer was primarily used as a tool to download Chrome or Firefox because it was the only thing available? Shortly after IE died, Edge inherited that legacy, becoming the browser you often had to use just to get the browser you actually wanted. Even Microsoft knows this: For years, we have endured the relentless pop-ups after updates, third parties being blocked from changing the default browser on Windows 11, banners appearing when you dare visit a competitor's download page, a fake "how to uninstall Edge" guide, and links within Windows apps that just had to open in Edge, regardless of your set preferences. Microsoft has announced it is dialing back some of this aggressive behavior, promising a reprieve from the constant Edge bombardment. But (and it's a pretty big but) this only applies if you're in the EEA. This shift isn't Microsoft suddenly having a profound change of heart and deciding to respect user choice out of the goodness of its heart. No, this is all thanks to the Digital Markets Act, a major EU rule that targets big online platforms, what they call "gatekeepers", because these companies have a huge impact on how the digital market works. So, what is actually changing for users in the EEA? For starters, Microsoft Edge will not prompt you to set it as the default browser unless you actually open it directly, like by clicking its icon on the taskbar. This specific change started rolling out with Edge version 137.0.3296.52. Other Microsoft apps will also stop bugging you to reinstall Edge if you dared to remove it, with updates for this rolling out in June to Windows 10 and 11. And speaking of default browsers, this is where a significant improvement lies. Previously, hitting "Set default" for your browser in Windows was half baked, only grabbing basic web links like http and https and HTML files. Now, if you're in the EEA, setting your default browser will also cover more obscure link types like ftp and "read," plus a wider array of web-related file formats such as .mht, .svg, .xml, and even .pdf files, provided your chosen browser says it can handle them. The Bing app and those Windows Widgets, which previously had a nasty habit of ignoring your browser choice, will also start opening web links in your default browser. Hallelujah. Users in the EEA will also gain the ability to uninstall the Microsoft Store entirely later this year, though apps previously installed from it will still receive updates. Windows Search is also getting an upgrade in the EEA. Right now, searching from the taskbar mostly just sends you to Bing, no matter what browser you use. But for users in the EEA, other apps will be able to plug into Windows Search and show web results too. If an app registers as a web search provider, it'll start working as soon as you install it. You'll also be able to see results from multiple providers in the search interface, not just Bing. The usual scoping tabs will still be there if you want to filter things, but the default view will be more varied. And yes, you'll even be able to reorder the providers in Settings. These changes are already in Windows Insider builds and are expected to roll out to Windows 10 and 11 in early June.
    • Star Trek: Strange New Worlds (Paramount+)

      By WaynesWorld · Posted

      A few things I am wondering about for S3: A.  What's Pike doo gonna look like this time around....yea I've watched the trailers & it looks poofed up, but still.... B. When will the unintelligible, physco-babbling Pelia go away (or at least learn how to speak English properly, without that crappy, slurred accent that sounds like she's on crack, Mary Jane, & LSD at the same time) ?  Hopefully Scotty's arrival will mean her departure is near.... C.  When do we get to see more of the stunningly gorgeous No. 1, preferably in regular/civilian clothes that show off her physical attributes better ? D. Is Spock EVER gonna get laid properly, human style ?  I feel certain that Christine could make any Vulcan-human horizontal bomp a thing to remember for a LONG time  E.  Can we PLEEEEEEZE get rid of the hatchet-head/buzz cut hair styles on Ortega & anyone else that has it....  But otherwise, as Pike says:  HIT IT !  

  • Recent Achievements

    • One Year In
      WaynesWorld earned a badge
      One Year In
    • First Post
      chriskinney317 earned a badge
      First Post
    • Week One Done
      Nullun earned a badge
      Week One Done
    • First Post
      sultangris earned a badge
      First Post
    • Reacting Well
      sultangris earned a badge
      Reacting Well

  • Popular Contributors

    1. 1
      +primortal
      172
    2. 2
      ATLien_0
      124
    3. 3
      snowy owl
      123
    4. 4
      Xenon
      118
    5. 5
      +Edouard
      92
    Show More

  • Tell a friend

    Love Neowin? Tell a friend!