3 Replies Latest reply: Dec 28, 2015 3:15 PM by Alessandro Furtado RSS

    Disparo de e-mail

    Luana Ribeiro

      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