0 Replies Latest reply: Feb 13, 2018 5:55 AM by anil mishra RSS

    How to export each row of sheet object "CH01" into separate .xls file & then mail merge into .docx file & then export .docx into .pdf file & then send it  through email.

    anil mishra

      Dear All,

       

      I have the following macro code through which I am exporting all rows of Sheet Object "CH01" into a single pdf file & sending through email but...I want that

       

      If a customer (Customer_ID) have many different invoices then ..

       

      Data of first row (first invoice) should be exported into a excel file & then

      Data of excel sheet should automatically be linked with a document file (.docx) which format is designed to get data of excel file using mail merging & then...

       

      Each mail merged output file should be exported into .pdf & then send through email.

       

      I wan to get help that what & where I have to change in the below VBS.

       

      For Example.....

      A customer_id =N0000B91 have following invoices data in the sheet object...."CH01"

      Invoice No.  Qty Value

      100              1     100

      101              2     200

      103              3     300.

      104              4     400

      105              5     500

       

      & I have a single document file(.docx) in which I have to designed to get output using variable of exported excel sheet of first rows of Sheet object"CH01" i.e. invoice details of invoice number 100 & then after mail merging  output file .docx will export into .pdf & will be send thriough email. I also want to generate each file with diffrent file name using field value "Parent_Name".

       

       

      Very urgent please provide macro code with examples.

       

       

       

       

       

       

      '******************************** EMAIL FUNCTIONS *********************************

       

       

       

       

      function sendCDOMail()

        'ActiveDocument.Fields("ZONE").Clear

       

        'set fld=ActiveDocument.GetField("PARENT_ID")

       

        'msgbox("The field has "& fld.GetValueCount(2) &" selected values")

        'fld.GetValueCount(2)-1

      Const cdoBasic = 1 'basic (clear-text) authentication

      Call deleteReports

       

        Set z = ActiveDocument.Fields("ZONE").GetPossibleValues

       

        ''''''''''''''''''''

        set docprop = ActiveDocument.GetProperties

      set ps = docprop.PrintSheetSettings

      ps.SheetPrintDrawBackGround = true

      ActiveDocument.SetProperties docprop

       

        ''''''''''''''''''''''''

       

        For j=0 to z.Count-1

        set k = ActiveDocument.Fields("ZONE")

        set kv = k.GetSelectedValues

        if kv.Count<>0 then

       

        kv.RemoveAt 0

       

        End if

        ActiveDocument.Fields("EMAIL").Clear

        ActiveDocument.Fields("PARENT_ID").Clear

       

        ActiveDocument.Fields("ZONE").Select z(j).Text

       

        ActiveDocument.Fields("EMAIL").Clear

        ActiveDocument.Fields("PARENT_ID").Clear

       

        Set Temp = ActiveDocument.Fields("PARENT_ID").GetPossibleValues

       

       

        for i=0 to Temp.Count-1

       

        Dim objEmail

        Dim strMailTo

        'Creat New Message

        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") = "smtp.bilt.com"

          .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 0

          .Item("http://schemas.microsoft.com/cdo/configuration/sendusername")="customercare@bilt.com"

          .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword")="cust0mer@c@re"

          .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

       

        set f = ActiveDocument.Fields("PARENT_ID")

        set fv = f.GetSelectedValues

        if fv.Count<>0 then

        fv.RemoveAt 0

        End if

        ActiveDocument.Fields("PARENT_ID").Select Temp(i).Text

        set Email=ActiveDocument.Fields("EMAIL").GetPossibleValues

        'set obj = ActiveDocument.GetSheetObject("CH01")

        set Parent_name=ActiveDocument.Fields("PARENT_NAME").GetPossibleValues

        'obj.ExportBiff "D:\MAIL ALERTS\Opti_Customer_Invoice_Mail_Alert\" & Parent_name.Item(0).Text &"-"& Temp(i).Text & ".xls"

        set mail=ActiveDocument.Fields("MAIL").GetPossibleValues

        set DT=ActiveDocument.Fields("PROCESS_DATE").GetPossibleValues

        set V = ActiveDocument.Fields("Valid").GetPossibleValues

        set BG = ActiveDocument.Fields("BILLING_GROUP_ID").GetPossibleValues

        ''''''''''''''''

       

       

      'set docprop = ActiveDocument.GetProperties

      'set ps = docprop.PrintSheetSettings

      ' ps.SheetPrintDrawBackGround = true

      'ActiveDocument.SetProperties docprop

       

      'tempFolder="D:\MAIL ALERTS\Opti_Customer_Invoice_Mail_Alert\" 'EDIT Outputpath here

      reportName="TestDashboard"

      reportFile = "D:\ZZ\" & Parent_name.Item(0).Text &"-"& Temp(i).Text & ".pdf"

      'msgbox reportFile

      PrintPDFWithBullZip reportFile, mergeFlag

      ActiveDocument.GetApplication.Sleep 5000

      ActiveDocument.GetSheetObject("CH01").print 'EDIT your Object ID here

      ActiveDocument.GetApplication.Sleep 5000

       

       

       

       

       

       

       

        ''''''''''''''''''

       

        objEmail.From = "customercare@bilt.com"

        objEmail.Sender = "customercare@bilt.com"

        if V(0).Text="Y" then

        objEmail.To =  "anil.mishra@bilt.com"

        'objEmail.To =  Email(0).Text

        'objEmail.Cc = mail.Item(0).Text

        'objEmail.BCc ="sunil.rajpal@bilt.com;prakash.mahapatro@bilt.com;anil.mishra@bilt.com"

        objEmail.Subject = "Invoice Details for the Date of " & DT.Item(0).Text & " to " & Temp(i).Text &"-"&Parent_name.Item(0).Text

        IF BG(0).TEXT="02" OR BG(0).TEXT="12" OR BG(0).TEXT="07" OR BG(0).TEXT="17" THEN

        objEmail.HTMLBody = "Invoice Details for the Date of " & DT.Item(0).Text & " to " & Temp(i).Text &"-"&Parent_name.Item(0).Text  & vbCrLf &"<HTML><BR><BR> <font Size=1>******** This is an auto-generated mail. Please do not reply to this email id. The property in goods pass on to buyer on invoicing and our risks & responsibilities ceases there on For any clarifications or queries, please contact your concerned RSO.*****</Font></HTML>"

        ELSE

        objEmail.HTMLBody = "Invoice Details for the Date of " & DT.Item(0).Text & " to " & Temp(i).Text &"-"&Parent_name.Item(0).Text  & vbCrLf &"<HTML><BR><BR> ******** This is an auto-generated mail. Please do not reply to this email id. For any clarifications or queries, please contact your concerned RSO.  *****</HTML>"

        end if

        objEmail.AddAttachment "D:\ZZ\" & Parent_name.Item(0).Text &"-"& Temp(i).Text & ".pdf"

        objEmail.Send

        else

        '******************* If E-Mail ID Not Valid Executes Mail To Below ID's *******************

        objEmail.To =  "anil.mishra@bilt.com"

        'objEmail.To =  mail.Item(0).Text

        objEmail.Subject = "The Customer : " & Temp(i).Text &"-"&Parent_name.Item(0).Text & " E - Mail Id is Invalid. Please Correct it."

        objEmail.TextBody = "Invoice Details for the Date of " & DT.Item(0).Text & " to " & Temp(i).Text &"-"&Parent_name.Item(0).Text

        objEmail.AddAttachment "D:\ZZ\" & Parent_name.Item(0).Text &"-"& Temp(i).Text & ".pdf"

        objEmail.Send

        End if

        Set objFlds = Nothing

        Set objConf = Nothing

        Set objEmail = Nothing

        next

      Next

      ActiveDocument.Fields("ZONE").Clear

      ActiveDocument.Fields("EMAIL").Clear

      ActiveDocument.Fields("PARENT_ID").Clear

      ActiveDocument.Save

      ActiveDocument.GetApplication.Quit

      end function

       

       

       

       

      '***************************** END OF EMAIL SECTION ***************************************

       

       

      function deleteReports()

        Set FSOObj = CreateObject("scripting.FileSystemObject")

        IF NOT FSOObj.FolderExists("D:\MAIL ALERTS\Opti_Customer_Invoice_Mail_Alert") then

         FSOObj.CreateFolder("D:\ZZ")

        Else

          FSOObj.DeleteFile ("D:\ZZ\*.*"), True

        end if

      end function

       

       

      '***************************** Function For Validating E-Mail Address **************************

       

       

      'sub Export

      'set docprop = ActiveDocument.GetProperties

      'set ps = docprop.PrintSheetSettings

      ' ps.SheetPrintDrawBackGround = true

      'ActiveDocument.SetProperties docprop

       

      'tempFolder="D:\ZZ\" 'EDIT Outputpath here

      'reportName="TestDashboard"

      ' reportFile = tempFolder & reportName & day(date) & monthname(month(date))&".pdf"

      'msgbox reportFile

      ' PrintPDFWithBullZip reportFile, mergeFlag

      ' ActiveDocument.GetApplication.Sleep 5000

      ' ActiveDocument.GetSheetObject("CH01").print 'EDIT your Object ID here

      ' ActiveDocument.GetApplication.Sleep 5000

      ' msgbox "saved."

      ' end sub

      '===========================================================================

       

       

      Function printReportPDF(pdfOutputFile)

      Set WSHShell = CreateObject("WScript.Shell")

      WSHShell.RegWrite "HKCU\Software\QlikviewPDF\OutputFile", pdfOutputFile, "REG_SZ"

      WSHShell.RegWrite "HKCU\Software\QlikviewPDF\BypassSaveAs", "1", "REG_SZ"

      Set WSHShell = nothing

      End function 

       

       

       

       

      FUNCTION PrintPDFWithBullZip (pdfOutputFile, mergeFlag)

          set obj = CreateObject("Bullzip.PDFSettings")

          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.SetValue "Orientation", "landscape"

          if mergeFlag = true then 'merge multiple pages into 1 file

              obj.SetValue "mergefile", pdfOutputFile

          end if

         

          obj.WriteSettings True

      END FUNCTION

       

      With thanks & regards..

      AKM