'constants adTypeBinary = 1 adOpenKeySet = 1 adLockOptimistic = 3 adSaveCreateOverwrite = 2 adTypeText = 2 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 fld ' Dim fld As DAO.Field Dim strConn Dim strTableHeader '******************* '*** EDIT THESE ! '******************* strServer = "mailrelay.{smtp server}.net" strSender = "ServiceAccount@{some email}.com" strRecipient = "DistributionList@{some where}.com" strSubject = "Query Results Email" strQuery = "select * from sysusers;" strConn = "Driver={SQL Server};server=(local);database=master;sspi=true;" Set objConn = CreateObject("ADODB.Connection") Set objRS = CreateObject("ADODB.Recordset") objConn.Open strConn objRS.Open strQuery, objConn, adOpenKeyset, adLockOptimistic if (objRS.BOF and objRS.EOF) then strMessage = "No Records found." Else strMessage = "

Results of some query.

" 'Now output the contents of the Recordset ' build header for Table from fields objRS.MoveFirst strTableHeader = "" for each field in objRS.Fields strTableHeader = strTableHeader + "" Next strTableHeader = strTableHeader + "" strMessage = strMessage + strTableHeader Do While Not objRS.EOF strMessage = strMessage + "" i = 0 for each field in objRS.Fields 'strMessage = strMessage + "" If IsNull(objRS.fields.item(i).value) then strMessage = strMessage & "" Else if (objRS.fields.item(i).type = 204) then 'varbinary data type strMessage = strMessage & "" Else strMessage = strMessage & "" End If End If i = i + 1 Next strMessage = strMessage + "" 'move to the next record objRS.MoveNext Loop strMessage = strMessage + "

" + field.name + "
" + objRS.fields.item(i).value + "		0x" & ConvertByteArray(objRS(i)) &"	" & Cstr(objRS.fields.item(i).value) & "

" End If strMessage = strMessage + "" SendEmail strServer, strSender, strRecipient, strSubject, strMessage objRS.Close set objRS = Nothing objConn.Close set objConn = Nothing Sub SendEmail (server, sndr, rcpt, subj, msg) Dim iMsg, iConf, Flds ' Set the visual basic constants as they do not exist within VBScript. 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 .Item(cdoSMTPServer) = server ' ' Optional Fields ' .Item(cdoSMTPServerPort) = 25 ' .Item(cdoSendEmailAddress) = """MySelf"" " ' .Item(cdoSendUserReplyEmailAddress) = """Another"" " ' .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), "") Then iMsg.HTMLBody = msg Else iMsg.TextBody = msg End If ' An attachment can be included. 'iMsg.AddAttachment Attachment ' Send the message. iMsg.Send End Sub Function ConvertByteArray(arr) Dim str Dim ln Dim i Dim ret str = CStr(arr) ln = LenB(str) ret = "" For i = 1 To ln ret = ret & Right("00" & Hex(AscB(MidB(str, i, 1))), 2) Next ConvertByteArray = ret End Function