add a condition to macro that send a multiple reports

wisetrackchile — Wed, 25 Nov 2020 16:16:04 GMT

Hi,

I have a report that is sent daily to different managers in the company with the speed violation of car fleet they have. This is a daily report and it works great, I need to add the number of alerts in the email subject and in the body email, so in the case, there are no alerts the manager knows before opening the PDF.

the object ID I want to use is called TX53

I leave the macro I use for the report

' --------------------------------------------------------
'| Function: HtmlEncoding
' --------------------------------------------------------
Function HtmlEncoding (strInput)
strOutput = strInput

'Lower-case Tilde Vowels
strOutput = Replace(strOutput, "á", "á")
strOutput = Replace(strOutput, "é", "é")
strOutput = Replace(strOutput, "í", "í")
strOutput = Replace(strOutput, "ó", "ó")
strOutput = Replace(strOutput, "ú", "ú")

'Upper-case Tilde Vowels
strOutput = Replace(strOutput, "Á", "Á")
strOutput = Replace(strOutput, "É", "É")
strOutput = Replace(strOutput, "Í", "Í")
strOutput = Replace(strOutput, "Ó", "Ó")
strOutput = Replace(strOutput, "Ú", "Ú")

HtmlEncoding = strOutput
End Function
' --------------------------------------------------------
'| Function: ReadTxtFile
'| Descripcion: Leer variable desde archivo de texto
' --------------------------------------------------------
Function ReadTxtFile (strFile)
Const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(Replace(ActiveDocument.GetPathName, "Reporte\companyname_Reporte-Diario-por-Gerencia.qvw", "") & "External\" & strFile, ForReading)
Do Until objFile.AtEndOfStream
strSearchString = objFile.ReadLine
Loop
objFile.Close
ReadTxtFile = strSearchString
End Function

' --------------------------------------------------------
'| Function: MyPrintPDFWithBullZip
'| Description: CreatePDF
' --------------------------------------------------------
Sub PrintPDF (strReportFile, strReportID)
set obj = CreateObject("Bullzip.PdfSettings")
obj.SetValue "Output" , strReportFile
obj.SetValue "ConfirmOverwrite", "no"
obj.SetValue "ShowSaveAS", "never"
obj.SetValue "ShowSettings", "never"
obj.SetValue "ShowPDF", showFile
obj.SetValue "RememberLastFileName", "no"
obj.SetValue "RememberLastFolderName", "no"
obj.SetValue "ShowProgressFinished", "no"
obj.SetValue "ShowProgress", "no"
obj.WriteSettings True

ActiveDocument.PrintReport(strReportID), "Bullzip PDF Printer", false
End Sub

' --------------------------------------------------------
'| Function: SendReport
'| Descripcion: Funcion principal.
' --------------------------------------------------------
Sub SendReport (strGerencia, strDestinatario)
ActiveDocument.ClearAll true
ActiveDocument.Variables("vGerencia").SetContent strGerencia, true

'---------------------------------------------------------------------
' Date Variables
vFecha = date()-1
ActiveDocument.GetField("Calendar.Fecha").Select vFecha
vDiaMes = right("00" & day(vFecha),2)
set obj = ActiveDocument.GetSheetObject("TX62")
vDiaSemana = obj.GetCell(0,0).Text
vMes = right("00" & month(vFecha),2)
vAnio = Year(vFecha)
vSerial = vAnio & vMes & vDiaMes

'---------------------------------------------------------------------
' PDF Report Configuration
strReportID = "RP01"
strReportName = "Codelco_Reporte-Diario_" & strGerencia & "_" & vSerial
strReportPath = Replace(ActiveDocument.GetPathName, "Companyname_Reporte-Diario-por-Gerencia.qvw", "") & "Historial\"
strReportFile = strReportPath & strReportName & ".pdf"

'---------------------------------------------------------------------
' PDF Report Print
Call PrintPDF (strReportFile, strReportID)
ActiveDocument.GetApplication.Sleep 5000

'---------------------------------------------------------------------
' Email Content
'"<meta http-equiv=" & chr(34) & "Content-Type" & chr(34) & " content=" & chr(34) & "text/html; charset=utf-8" & chr(34) & " />" & _
strEmailSubject = "Companyname- Reporte Diario - " & strGerencia & " - " & vFecha
strEmailBody = "<!DOCTYPE html PUBLIC" & chr(34) & "-//W3C//DTD XHTML 1.0 Transitional//EN" & chr(34) & " " & chr(34) & "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd" & chr(34) & ">" & _
"<html xmlns=" & chr(34) & "http://www.w3.org/1999/xhtml" & chr(34) & ">" & _
"<head>" & _
"<meta http-equiv=" & chr(34) & "Content-Type" & chr(34) & " content=" & chr(34) & "text/html" & chr(34) & " />" & _
"<title>" & strEmailSubject & "</title>" & _
"<meta name=" & chr(34) & "viewport" & chr(34) & " content=" & chr(34) & "width=device-width, initial-scale=1.0" & chr(34) & "/>" & _
"</head>" & _
"<body>" & _
"Estimado(a),<br>" & _
"<br>Se adjunta reporte diario, " & strGerencia & ", correspondiente al día " & HtmlEncoding(vDiaSemana) & " " & vFecha & "." & _
"</body>" & _
"</html>"

'---------------------------------------------------------------------
' Email Object
Set objEmail = CreateObject("CDO.Message")
Set msgConf = objEmail.Configuration.Fields

'---------------------------------------------------------------------
' SMTP server details
msgConf.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
msgConf.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.office365.com"
msgConf.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = true
msgConf.Item("http://schemas.microsoft.com/cdo/configuration/StartTLS") = true
msgConf.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
msgConf.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
msgConf.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxx@xxxx.xx"
msgConf.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxxxxxxxxx"
msgConf.Update

objEmail.To = strDestinatario
objEmail.BCC = "xxx@xxx.xx"
objEmail.From = "send@report.com"
objEmail.Subject = strEmailSubject
objEmail.HtmlBody = strEmailBody
objEmail.AddAttachment strReportFile

'---------------------------------------------------------------------
' Send Email
objEmail.Send
Set msgConf = Nothing
Set objEmail = Nothing
End Sub

' --------------------------------------------------------
'| Function: Main
'| Descripcion: Instruccion principal del reporte
' --------------------------------------------------------

Sub Main
vSendMail = ReadTxtFile("SendMail.txt")
If vSendMail = 1 Then
Call SendReport("SERVICIOS Y SUMINISTROS","xxx@xxx.xx")
Call SendReport("GERENCIA HOSPITAL DE COBRE","xxx@xxx.xx")
Call SendReport("GERENCIA GENERAL","xxx@xxx.xx")
Call SendReport("REFINERIA","xxx@xxx.xx")
Call SendReport("RECURSOS MINEROS Y DESARROLLO","xxx@xxx.xx")
Call SendReport("RECURSOS HUMANOS","xxx@xxx.xx")
Call SendReport("PROYECTOS","xxx@xxx.xx")
Call SendReport("GERENCIA OPERACIONES","xxx@xxx.xx")
Call SendReport("MINA","xxx@xxx.xx")
Call SendReport("FUNDICION","xxx@xxx.xx")
Call SendReport("EXTRACCION Y LIXIVIACION","xxx@xxx.xx")
Call SendReport("CONCENTRADORA","xxx@xxx.xx")
Call SendReport("ADMINISTRACION","xxx@xxx.xx")
Call SendReport("SUSTENTABILIDAD Y ASUNTOS EXTERNOS","xxx@xxx.xx")
Call SendReport("SEGURIDAD Y SALUD OCUPACIONAL","xxx@xxx.xx")
Call SendReport("GG CONSEJERIA JURIDICA","xxx@xxx.xx")
End If
End Sub

thanks for the replay.

NRC

topic add a condition to macro that send a multiple reports in QlikView

add a condition to macro that send a multiple reports