Unlock a world of possibilities! Login now and discover the exclusive benefits awaiting you.
Pessoal,
Achei a macro abaixo aqui na comunidade, podem me dar uma ajuda com a mesma?
Sub TabelaPreco
'Imprime Tabela de Preço
'Chamada da função passando os seguintes argumentos - 1: Nome do arquivo a ser gerado - 2: Nome do Report a ser gerado
PrintPDF "teste", "RP01"
ActiveDocument.GetApplication.WaitForIdle
Email()
End Sub
Sub PrintPDF(ReportName, ReportID)
'Caminho a ser gerado o relatório encontra-se na variável
Path = ActiveDocument.Evaluate("vPathArquivos")
'Criando instância do PDFCreator
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
'Variáveis de configuração da biblioteca PDFCreator
With pdfjob
'Verificações da fila da impressora
If .cStart("/NoProcessingAtStartup") = False Then
If .cStart("/NoProcessingAtStartup", True) = False Then
'Caso não tenha nenhum objeto na fila de impressão, termina a macro.
Exit Sub
End if
'Caso tenha objeto na fila de impressão, torne a impressão visível
.cVisible = True
End If
.cOption("UseAutosave") = 1 'Permitir o Autosave
.cOption("UseAutosaveDirectory") = 1 'Permitir que grave no diretório
.cOption("AutosaveDirectory") = Path 'Caminho que será gravado o relatório
.cOption("AutosaveFilename") = ReportName 'Nome que será gravado o relatório
.cOption("AutosaveFormat") = 0 'Formato PDF
.cClearCache
'Finalizando as configurações da biblioteca PDFCreator
End With
'Imprime o relatório
ActiveDocument.PrintReport ReportID, "PDFCreator"
'Aguarde até que o processo entre na fila de impressão
Do Until pdfjob.cCountOfPrintjobs = 1
ActiveDocument.GetApplication.Sleep 20
Loop
pdfjob.cPrinterStop = False
'Aguarda até que a fila de impressão esteja vazia
Do Until pdfjob.cCountOfPrintjobs = 0
ActiveDocument.GetApplication.Sleep 20
Loop
'Termina o processo
pdfjob.cClose
'Zerando a variável
Set pdfjob = Nothing
End Sub
Sub Email
on error resume next
Const schema = "http://schemas.microsoft.com/cdo/configuration/"
Const cdoBasic = 1
Const cdoSendUsingPort = 2
Dim oMsg, oConf
' Propriedades do email
Set oMsg = CreateObject("CDO.Message")
oMsg.From = "seuemail" ' ou "Nome do remetente <from@gmail.com>"
oMsg.To = "destinatario" ' ou "Nome do destino <to@gmail.com>"
oMsg.Subject = "Teste de VBscript"
oMsg.TextBody = "Envio anexo !!! Enjoy it"
oMsg.AddAttachment "Caminho anexo"
' Configuração e autenticação do seu servidor de SMTP BOL
Set oConf = oMsg.Configuration
'Endereço do servidor de SMTP
oConf.Fields(schema & "smtpserver") = "smtps.bol.com.br"
'Número da porta
oConf.Fields(schema & "smtpserverport") = 587
oConf.Fields(schema & "sendusing") = cdoSendUsingPort
'Tipo de autenticacao
oConf.Fields(schema & "smtpauthenticate") = cdoBasic
'Uso da Encriptação SSL
oConf.Fields(schema & "smtpusessl") = False
'Envia username
oConf.Fields(schema & "sendusername") = "seuemail"
'Envia password
oConf.Fields(schema & "sendpassword") = "suasenha"
oConf.Fields.Update()
' Envia mensagem
oMsg.Send()
' Retorna o status da mensagem
If Err Then
resultMessage = "ERROR " & Err.Number & ": " & Err.Description
Err.Clear()
Else
resultMessage = "Mensagem enviada com sucesso !!!"
End If
Wscript.echo(resultMessage)
End Sub
Pessoal, tbm achei a macro abaixo, ela exporta a imagem, porém não disparada, dá um erro de : "CDO.Message"
Sub ExportEmail
Set obj = ActiveDocument.ActiveSheet
obj.ExportBitmapToFile "C:\\TestImageJPG.jpg"
MsgBox "Exported"
' Object creation
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") = 25
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "sender email address"
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = 1
msgConf.Fields.Update
objMsg.Subject = "Export & Import"
objMsg.To = "receiver email address"
objMsg.From = "sender email address"
objMsg.HTMLBody = "<html><body>Embedded Image:<br><img src=""E:\\TestImageJPG.jpg""></body></html>"
Set objMsg.Configuration = msgConf
' Send
objMsg.Send
Msgbox("Email Sent")
' Clear
Set objMsg = nothing
Set msgConf = nothing
End Sub
Pessoal, tbm achei a macro abaixo, ela exporta a imagem, porém não disparada, dá um erro de : "CDO.Message"
Sub ExportEmail
Set obj = ActiveDocument.ActiveSheet
obj.ExportBitmapToFile "C:\\TestImageJPG.jpg"
MsgBox "Exported"
' Object creation
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") = 25
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "sender email address"
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = 1
msgConf.Fields.Update
objMsg.Subject = "Export & Import"
objMsg.To = "receiver email address"
objMsg.From = "sender email address"
objMsg.HTMLBody = "<html><body>Embedded Image:<br><img src=""E:\\TestImageJPG.jpg""></body></html>"
Set objMsg.Configuration = msgConf
' Send
objMsg.Send
Msgbox("Email Sent")
' Clear
Set objMsg = nothing
Set msgConf = nothing
End Sub
Luana,
O PDFCREATOR, caso você queira ele faz todo o trabalho para você.
Pois você poder, configurar nele o smtp e deixar ele enviar sozinho.
Luana,
segue um modelo que gera PDFs e envia por email para quem sabe lhe ajudar.
Neste modelo, se descomentar o FOR / NEXT na macro, podes fazer com que seja disparado um email para cada campo (como se fosse selecionado um a um o campo.... !)