Unlock a world of possibilities! Login now and discover the exclusive benefits awaiting you.
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
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
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
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
Obrigado deu certo
tamojunto