3 Replies Latest reply: Apr 10, 2018 10:58 AM by Thiago Justen Teixeira RSS

    Anexar objeto em formato csv para enviar para o email.

    agnaldo neves

      Abaixo tenho dois script vba:

      O primeiro envia o email (Mas no lugar da image gostaria de enviar  C:\exportar\Vencidas_5_Dias com anexo)C:\exportar\Vencidas_5_Dias

      O segundo gerar um objeto em arquivo csv.

      Alguém consegue me ajudar .

      Os dois estão funcionando apenas o primeiro não está anexando nada mas o email está enviado.

       

      "CC:\expor

       

       

      1 -Esta enviado mas sem anexo:

      
      
      Sub ExportEmail
      'Export the qlikview sheet as image to predestined location
      Set obj = ActiveDocument.ActiveSheet 
      obj.ExportBitmapToFile "C:\exportar\TestImageJPG.jpg"
      'MsgBox "Exportado" 
      'criação de objeto 
      set objMsg = CreateObject ( "CDO.Message") 
      Set msgConf = CreateObject ( "CDO.Configuration")  
      
      
      ' Server Configuration 
      msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 
      msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com" 
      msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465 
      msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 
      msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "x@gmail.com" 
      msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "linx***" 
      msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = 1 
      msgConf.Fields.Update 
      ' Email 
      objMsg.Subject = "Export & Import" 
      objMsg.To = "athx@gmail.com" 
      objMsg.From = "bi.x@gmail.com" 
      objMsg.HTMLBody = "<html><body>Embedded Image:<br><img src=""C:\exportar\TestImageJPG.jpg""></body></html>"
      Set objMsg.Configuration = msgConf 
      ' Send 
      objMsg.Send 
      'Msgbox("Email Sent")
      ' Clear 
      Set objMsg = nothing 
      Set msgConf = nothing
      End Sub 
      

       

       

      2 -Exportar Objeto está funcionando:

      sub ExportChartToCustomDelimitedFile1()   
      'exports a chart to a semicolon or other user specified delimited file  
      'removing as many headers as specified at the same time  
        
        
      'constants  
      output_dir="C:\exportar\Vencidas_5_Dias\"  
      FileType=".csv" 'csv or txt has been tested and works correctly  
      Filename1="Vendas_1" & replace(date(),"/","") & FileType  
      Filename2="Vencidas_5_Dias_"  & replace(date(),"/","") & FileType  
      HeaderRows=0 
      Delimiter=","  
      StartDateTime=now()  
        
        
      'exporting chart to file with headers  
      set obj = ActiveDocument.GetSheetObject("CH07")  
      obj.Export (output_dir & Filename1) , Delimiter  
        
        
      'opening chart file with headers  
      Set objFSO1 = CreateObject("Scripting.FileSystemObject")     
      set textFile1 = objFSO1.GetFile(output_dir & Filename1)  
      set textStream1 = textFile1.OpenAsTextStream(1)  
        
        
      'opening or creating chart file with no headers  
      Set objFSO2 = CreateObject("Scripting.FileSystemObject")     
      If not objFSO2.FileExists (output_dir & Filename2) then   
        Set newTextFile = objFSO2.CreateTextFile(output_dir & Filename2, True)  
        newTextFile.Close  
        Set newTextFile = nothing  
      End if  
      set textFile2 = objFSO2.GetFile(output_dir & Filename2)  
      set textStream2 = textFile2.OpenAsTextStream(2)  
        
        
      'removing header rows  
      for i = 1 to HeaderRows  
        textStream1.SkipLine()  
      Next  
        
        
      'read lines from file 1 and write them to file 2  
      do while textStream1.AtEndOfStream = false  
        textStream2.WriteLine(textStream1.ReadLine())  
      loop  
        
        
      'clean up  
      textStream1.Close  
      textStream2.Close  
        
        
      textFile1.Delete  
        
        
      Set objFSO1 = nothing  
      set textFile1 = nothing  
      set textStream1 = nothing  
        
        
      Set objFSO2 = nothing     
      set textFile2 = nothing  
      set textStream2 = nothing   
        
        
      'msgbox("Start Time : " & StartdateTime & chr(13) & "End Time   : " & now())  
        
        
      end sub