Skip to main content
cancel
Showing results for 
Search instead for 
Did you mean: 
Ribeiro
Specialist
Specialist

Anexar objeto em formato csv para enviar para o email.

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 

Neves
1 Solution

Accepted Solutions
Thiago_Justen_

Agnaldo, veja se te ajuda:

Sub SendExcel

'Excel Export

    set sObject = ActiveDocument.GetSheetObject("CH12045") 'set the ObjectID of the table you want to export

    set v=ActiveDocument.Variables("vpathXP") 'vpathXP is a QV Variable containing the path of csv (C:\Users\Admin\Desktop\Test\Test.csv)

    getVariable = v.GetContent.String

    sObject.Export v.GetContent.String, ","

   

'Email Setup  

Emailreceiverlist = "receiver1@gmail.com;receiver2@gmail.com;receiver3@gmail.com"

timestamp1 = Timer

Timestamp="-"&Year(Now())&"-"&Month(Now())&"-"&Day(Now())&"--"&Hour(Now())&"-"&Minute(Now())&"-"&Second(Now())

Dim objEmail

Const cdoSendUsingPort = 2 ' Send the message using SMTP

Const cdoBasicAuth = 1 ' Clear-text authentication

Const cdoTimeout = 60 ' Timeout for SMTP in seconds

mailServer = "smtp.gmail.com" 'adapt with your emailproviders smtp

SMTPport = 465

mailusername = "youremailadress@gmail.com"    'adapt with your credentials

mailpassword = "yourpassword" 'adapt with your credentials

mailto = Emailreceiverlist

mailSubject = "Excel Report"&Timestamp

mailBody = "Attached the current Report"

Set objEmail = CreateObject("CDO.Message")

Set objConf = objEmail.Configuration

Set objFlds = objConf.Fields

With objFlds

.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort

.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = mailServer

.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SMTPport

.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True

.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = cdoTimeout

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

.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = mailusername

.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = mailpassword

.Update

End With

objEmail.To = mailto

objEmail.From = mailusername

objEmail.Subject = mailSubject

objEmail.TextBody = mailBody

objEmail.AddAttachment "C:\Users\Admin\Desktop\Test\Test.csv"

objEmail.Send

Set objFlds = Nothing

Set objConf = Nothing

Set objEmail = Nothing

timestamp2 =  Timer       

MsgBox("the email sent to"&" "&Emailreceiverlist&""&" was successfully transferred."&" "&" the sendingprocess took "&"  "&Round((timestamp2-timestamp1)/60, 2)&"  "&"min.")  

End Sub

Thiago Justen Teixeira Gonçalves
Farol BI
WhatsApp: 24 98152-1675
Skype: justen.thiago

View solution in original post

3 Replies
Thiago_Justen_

Agnaldo, veja se te ajuda:

Sub SendExcel

'Excel Export

    set sObject = ActiveDocument.GetSheetObject("CH12045") 'set the ObjectID of the table you want to export

    set v=ActiveDocument.Variables("vpathXP") 'vpathXP is a QV Variable containing the path of csv (C:\Users\Admin\Desktop\Test\Test.csv)

    getVariable = v.GetContent.String

    sObject.Export v.GetContent.String, ","

   

'Email Setup  

Emailreceiverlist = "receiver1@gmail.com;receiver2@gmail.com;receiver3@gmail.com"

timestamp1 = Timer

Timestamp="-"&Year(Now())&"-"&Month(Now())&"-"&Day(Now())&"--"&Hour(Now())&"-"&Minute(Now())&"-"&Second(Now())

Dim objEmail

Const cdoSendUsingPort = 2 ' Send the message using SMTP

Const cdoBasicAuth = 1 ' Clear-text authentication

Const cdoTimeout = 60 ' Timeout for SMTP in seconds

mailServer = "smtp.gmail.com" 'adapt with your emailproviders smtp

SMTPport = 465

mailusername = "youremailadress@gmail.com"    'adapt with your credentials

mailpassword = "yourpassword" 'adapt with your credentials

mailto = Emailreceiverlist

mailSubject = "Excel Report"&Timestamp

mailBody = "Attached the current Report"

Set objEmail = CreateObject("CDO.Message")

Set objConf = objEmail.Configuration

Set objFlds = objConf.Fields

With objFlds

.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort

.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = mailServer

.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SMTPport

.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True

.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = cdoTimeout

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

.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = mailusername

.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = mailpassword

.Update

End With

objEmail.To = mailto

objEmail.From = mailusername

objEmail.Subject = mailSubject

objEmail.TextBody = mailBody

objEmail.AddAttachment "C:\Users\Admin\Desktop\Test\Test.csv"

objEmail.Send

Set objFlds = Nothing

Set objConf = Nothing

Set objEmail = Nothing

timestamp2 =  Timer       

MsgBox("the email sent to"&" "&Emailreceiverlist&""&" was successfully transferred."&" "&" the sendingprocess took "&"  "&Round((timestamp2-timestamp1)/60, 2)&"  "&"min.")  

End Sub

Thiago Justen Teixeira Gonçalves
Farol BI
WhatsApp: 24 98152-1675
Skype: justen.thiago
Ribeiro
Specialist
Specialist
Author

Obrigado deu certo

Neves
Thiago_Justen_

tamojunto‌

Thiago Justen Teixeira Gonçalves
Farol BI
WhatsApp: 24 98152-1675
Skype: justen.thiago