ActiveX component can't create object: 'Outlook.Application' error appering while run macro

[vikasmahajan]

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

[vikasmahajan]

Dear All,

Thanks

I Have resolved this by PD2.qvw which is attached.

Thanks for Reply

Vikas

[vikasmahajan]

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