Disparo de e-mail

[#1]

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

[#2 · Accepted solution]

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

' Email

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

[Ribeiro]

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.

Automatizar envio de pdf

[afurtado]

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.... !)