Unlock a world of possibilities! Login now and discover the exclusive benefits awaiting you.
Dear All
I have following macro I want to send email alerts from qlkview to user directly when I am running this
Activx Compnent cant create Object error is appering I am Using Version 11 and testing in server but same is
running in my desktop !
Any help will be appricated.
Thanks
Vikas
Following are the code of macro
sub ExcelFile
strDate = CDate(Date)
strDay = DatePart("d", strDate)
strMonth = DatePart("m", strDate)
strYear = DatePart("yyyy", strDate)
If strDay < 10 Then
strDay = "0" & strDay
End If
If strMonth < 10 Then
strMonth = "0" & strMonth
End If
GetFormattedDate = strMonth & "-" & strDay & "-" & strYear
Path = "D:\BI-DEVELOPMENT AREA-INDOCO\Vikas"
FileName = "Test_" & GetFormattedDate & ".xlsx"
set XLApp = CreateObject("Excel.Application")
XLApp.Visible = False
set XLDoc = XLApp.Workbooks.Add
Set A = ActiveDocument.GetSheetObject("CH14")
A.CopyBitmapToClipboard
XLDoc.Sheets(1).Paste()
' Set B = ActiveDocument.GetSheetObject("CH03")
' B.CopyBitmapToClipboard
' XLDoc.Sheets(2).Paste()
XLDoc.Sheets(1).Name = "Scheduled Releases"
XLDoc.Sheets(2).Name = "Off Cycle Enhancements"
XLDoc.Sheets(3).Delete
XLDoc.Sheets(1).Range("A1").Select
XLDoc.SaveAs Path & FileName
XLApp.Quit
strName = "vikasm@indoco.com"
'InputBox("Enter email address in jsmith@email.com format","vikasm@indoco.com")'
' Set myApp = CreateObject ("Outlook.Application")
Set vOlApp = CreateObject("Outlook.Application")
Set myMessage = myApp.CreateItem(olMailItem)
myMessage.BodyFormat = 3 'Outlook.OlBodyFormat.olFormatRichText
myMessage.To = strName
If strName = "" Then
Exit Sub
Else
myMessage.Attachments.Add "C:\temp\" & FileName
myMessage.Subject = "Test Email: " & Date()
myMessage.Send
msgBox("The test file for " & Date() & " was sent to " & strName & ".")
Set myMessage = Nothing
Set myApp = Nothing
Set myInspector = Nothing
Set myDoc = Nothing
end if
end sub
'
'
'
'
'sub ExcelFile
'
' strDate = CDate(Date)
' strDay = DatePart("d", strDate)
' strMonth = DatePart("m", strDate)
' strYear = DatePart("yyyy", strDate)
' If strDay < 10 Then
' strDay = "0" & strDay
' End If
' If strMonth < 10 Then
' strMonth = "0" & strMonth
' End If
' GetFormattedDate = strMonth & "-" & strDay & "-" & strYear
'
' Path = "C:\temp\"
' FileName = "Test_" & GetFormattedDate & ".xlsx"
'
' set XLApp = CreateObject("Excel.Application")
'
' XLApp.Visible = False
' set XLDoc = XLApp.Workbooks.Add
'
' Set v = ActiveDocument.Variables("vCount")
'
' Selection=v.GetContent.String
'
' ActiveDocument.GetSheetObject("CH14").CopyTableToClipboard true
' XLDoc.Sheets(1).Paste()
'
' XLDoc.Sheets(1).Columns("A:K").EntireColumn.AutoFit
'
' XLDoc.Sheets(1).Name = "Export"
'
' Set XLSheet = XLDoc.Sheets("Export")
' ActiveDocument.GetSheetObject("TX46").CopyTextToClipboard
' XLSheet.Range("A" & Selection).Select
' XLSheet.Paste
' XLSheet.Range("A1").Select
'
' XLDoc.Sheets(2).Delete
' XLDoc.Sheets(2).Delete
' XLDoc.SaveAs Path & FileName
' XLApp.Quit
'
' Set myApp = CreateObject ("Outlook.Application")
' Set myMessage = myApp.CreateItem(olMailItem)
' myMessage.BodyFormat = 3 'Outlook.OlBodyFormat.olFormatRichText
'
' myMessage.To = "vikasm@indoco.com"
'' InputBox("Enter email address in johnsmith@mail.com format","Email Address")
' myMessage.Attachments.Add "C:\temp\" & FileName
' myMessage.Subject = "Test File " & Date()
'
' myMessage.Send
' Msgbox("Email Sent Successfully")
'
'Set myMessage = Nothing
'Set myApp = Nothing
'Set myInspector = Nothing
'Set myDoc = Nothing
'
'end sub
Dear All,
Thanks
I Have resolved this by PD2.qvw which is attached.
Thanks for Reply
Vikas
Dear All,
Resolved with following code.
Vikas
Sub pagos
' ActiveDocument.reload
vReport = "RP01" 'Set report
vName = "Sales_Report" 'Name of output pdf
ActiveDocument.PrintReport(vReport), "Bullzip PDF Printer", false 'Printreport
reportFile = "C:\tmp\" & vName &".pdf" 'Setting outputname
MyPrintPDFWithBullZip(reportFile) 'Call pdf printer
ActiveDocument.GetApplication.Sleep 5000
' mailrapport
' ActiveDocument.S
'ActiveDocument.GetApplication.Sleep 5000
PrintReport()
ActiveDocument.Save
ActiveDocument.GetApplication.Quit
End sub
FUNCTION MyPrintPDFWithBullZip (pdfOutputFile)
Set obj_printer_util = CreateObject("Bullzip.PDFUtil")
printername = obj_printer_util.defaultprintername
set obj = CreateObject("Bullzip.PdfSettings")
obj.printername = obj_printer_util.defaultprintername
obj.SetValue "Output" , pdfOutputFile
obj.SetValue "ConfirmOverwrite", "no"
obj.SetValue "ShowSaveAS", "never"
obj.SetValue "ShowSettings", "never"
obj.SetValue "ShowPDF", "no"
obj.SetValue "RememberLastFileName", "no"
obj.SetValue "RememberLastFolderName", "no"
obj.SetValue "ShowProgressFinished", "no"
obj.SetValue "ShowProgress", "no"
obj.WriteSettings True
END FUNCTION
function GetVariable(varName)
Dim v
set v = ActiveDocument.Variables(varName)
GetVariable = v.GetContent.String
end function
Function PrintReport()
Set WSHShell = CreateObject("WScript.Shell")
vReport = "RP01" 'Set report
vName = "Sales_Report" 'Name of output pdf
reportFile = "C:\tmp\" & vName &".pdf" 'Setting outputname
fln = "C:\tmp\" & vName &".pdf" 'Setting outputname
RegKey = "HKEY_CURRENT_USER\Software\QlikViewPDF\"
WSHShell.RegWrite RegKey & "BypassSaveAs", 1
WSHShell.RegWrite RegKey & "OutputFile", fln
ActiveDocument.GetApplication.Sleep 1000
'ActiveDocument.PrintDocReport "RP01", "Sergio Schulze"
ActiveDocument.GetApplication.Sleep 1000
WSHShell.RegWrite RegKey & "BypassSaveAs", 0
WSHShell.RegWrite RegKey & "OutputFile", ""
Set WSHShell = nothing
Set objEmail = CreateObject("CDO.Message")
Set objConf = objEmail.Configuration
Set objFlds = objConf.Fields
With objFlds
'---------------------------------------------------------------------
' SMTP server details
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "100.0.0.199"
if len(vUser) > 0 then
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "Vikas"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = false
else
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 0
end if
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Update
'---------------------------------------------------------------------
End With
ActiveDocument.GetApplication.Sleep 1000
objEmail.To = "vikasm@indoco.com;smitat@indoco.com" ' "name@server.com"
objEmail.From = "vikasm@indoco.com"
objEmail.Subject = "Testing for auto sending Mails from Qlikview Server BULL ZIP"
objEmail.HTMLBody = "This Mail From MIS Team Sales Report "
objEmail.AddAttachment reportFile '"D:\BI-DEVELOPMENT AREA-INDOCO\Vikas\QlikView Printing.pdf"
On Error Resume Next
objEmail.Send
If Err Then
WScript.Echo "SendMail Failed:" & Err.Description
else
msgbox("Send Mail successfull")
End If
end function