Hi Allan,
We had received this kind of request from our compliance dept that they wanted to to have reports weekly based on EMP present in CA system. and we ended up creating a VBS script and scheudled it to run weekly using the task scheduler, please find the script below, you may have to modify the sql server name, sender email address , recpeint email address and smart host to get the report.
Dim con
Dim comp
Dim cmd
Dim retval, strUID
Dim lRow
'Dim adOpenStatic, adLockOptimistic, adUseClient
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adUseClient = 3
Const ForWriting = 2
lRow = 4
Set FSO = CreateObject("Scripting.FilesystemObject")
Set WshShell = Wscript.CreateObject("Wscript.shell")
lOutFPath = WshShell.CurrentDirectory & "\CA_Report_by_Emp.csv"
Set objTextFile = FSO.OpenTextFile(lOutFPath, ForWriting, True)
lConSTR = "Select tc.Name ,tu.EmployeeID,ta.address From tblCase tc, tblAddressUser tu, tblHistCaseAddressUser th,tblAddress ta " _
& "Where th.AddressOwnerID = tu.AddressOwnerID AND ta.AddressOwnerID=tu.AddressOwnerID AND tc.CaseID = th.CaseID AND th.EndDate IS NULL AND " _
& "tc.CaseID = th.CaseID AND th.EndDate IS NULL AND tc.Type=102 AND tu.MonitorStatusID=120 order by tc.Name"
'On Error Resume Next
'comp = GetComputerName()
Set objConn = CreateObject("ADODB.Connection")
Set objCmd = CreateObject("ADODB.Command")
Set objRec = CreateObject("ADODB.Recordset")
lStr = "DepartmentName,EmployeeID,Address"
ConnString = "Provider=SQLOLEDB.1;Data Source=ServerName;Initial Catalog=EVCACompliance;User ID=svc-caview-mum;Password=Nomura99;"
objConn.Open ConnString
objRec.Open lConSTR, objConn
Do While objRec.EOF = False
lStr = lStr & vbNewLine & """" & objRec(0) & """" & "," & objRec(1) & "," & objRec(2)
objRec.MoveNext
Loop
objTextFile.Write (lStr)
objTextFile.Close
objRec.Close
objConn.Close
MailSend
Sub MailSend()
Set WshShell = Wscript.CreateObject("Wscript.shell")
lDate = Now()
HtmlBody= HtmlBody & "<HTML>"
HtmlBody= HtmlBody & vbnewline & "<BODY>"
HtmlBody= HtmlBody & vbnewline & "<TABLE border=""0"" cellpadding=""0"" cellspacing=""0"" width=""100%"">"
HtmlBody= HtmlBody & vbnewline & "<TR>"
HtmlBody= HtmlBody & vbnewline & "<TD height=""26"" valign=""top"" style=""border-bottom: 2 inset #008000"">"
HtmlBody= HtmlBody & vbnewline & "<SPAN style=""font-family: Tahoma; font-weight:bold; font-size:14pt; color:rgb(00,80,00);""> CA Report by Employees </SPAN></TD>"
HtmlBody= HtmlBody & vbnewline & "<TD style=""border-bottom: 2 inset #008000"" align=""right"">"
HtmlBody= HtmlBody & vbnewline & "<SPAN style=""margin-right:2em; font-family: Tahoma; font-size: 8pt; color:rgb(00,80,00);"">" & lDate & "</SPAN>"
HtmlBody= HtmlBody & vbnewline & "<INPUT onClick=""history.back(-1)"" id=""buttonBack"" style=""display:none; width: 106; height: 21; color: #FFFFFF; background-color: #008000; border: 1 solid #008000; font-family: Tahoma; font-size:8pt;"" type=""button"" size=""70"" value="" << Back""></INPUT>"
HtmlBody= HtmlBody & vbnewline & "</TD>"
HtmlBody= HtmlBody & vbnewline & "</TR>"
HtmlBody= HtmlBody & vbnewline & "</TABLE>"
HtmlBody= HtmlBody & vbnewline & "<p><B>Thanks & Regards <br />"
HtmlBody= HtmlBody & vbnewline & "Vault Admins </B></p>"
HtmlBody= HtmlBody & vbnewline & "</BODY>"
HtmlBody= HtmlBody & vbnewline & "</HTML>"
lFrom="Senderemailaddress"
lRcpt = "Email address"
lCC = "Email address"
lBCC = "Email address"
lSub = "CA Report by Employees : " & Date
lsmtpserver = "smarthost"
lAttach = WshShell.CurrentDirectory & "\CA_Report_by_Emp.csv"
Set objEMail = CreateObject("CDO.Message")
objEMail.From = lFrom
objEMail.To = lRcpt
'objEMail.CC = lCC
objEMail.BCC = lBCC
objEMail.Subject = lSub
'objEMail.Textbody = lMBody
objEMail.HTMLBody = HtmlBody
objEMail.AddAttachment lAttach
objEMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = lsmtpserver
objEMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEMail.Configuration.Fields.update
objEmail.Send
End Sub