locked
Como Crio Uma Macro Automatica quando abre Excel ela manda E-mail pelo Outlook Automatico RRS feed

  • Discussão Geral

  • Pessoal, Preciso da Ajuda de Vcs!
    Tenho uma planilha que é alimentada diariamente quando abrir esta planilha indepedente do horario ou data eu queria que o Excel enviasse automatico um e-mail por Outlook, mais eu preciso que o excel envie o e-mail para alguns emails em especifico.

    Exemplo: Na planilha na Coluna P consta alguns endereços de e-mail que queria que enviasse os e-mails que estão nas Celulas da Coluna P 

    Será que é Possivel. Grato desde Ja a Todos

    quarta-feira, 9 de setembro de 2009 21:26

Todas as Respostas

  • Sub auto_open()



    'não esquecer a funcão html
        Dim rng As Range
        Dim OutApp As Object
        Dim OutMail As Object
        Dim decisao As VbMsgBoxResult
        
        
        decisao = MsgBox("Deseja enviar o email ? ", vbYesNo, "Gripe Suína")
        
        If decisao = vbYes Then
        
        With Application
            .EnableEvents = False
            .ScreenUpdating = False
        End With
     
        Set rng = Nothing
        Set rng = ActiveSheet.UsedRange
        'para usar um determinada sheet declarar assim:
        'Set rng = Sheets("YourSheet").UsedRange

        Set OutApp = CreateObject("Outlook.Application")
        OutApp.Session.Logon
        Set OutMail = OutApp.CreateItem(0)
     
        On Error Resume Next
        With OutMail
            .To = "emaildestino@emaildestino"
            .CC = ""
            .BCC = ""
            .Subject = "Report DT MYB 2G " & DateTime.Date
            .HTMLBody = RangetoHTML(rng)
            .Display   'para enviar direto use .send
        End With
        On Error GoTo 0
     
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With
     
        Set OutMail = Nothing
        Set OutApp = Nothing
        Else
        End If
    End Sub

    Function RangetoHTML(rng As Range)

        Dim fso As Object
        Dim ts As Object
        Dim TempFile As String
        Dim TempWB As Workbook
     
        TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
     
        'Copy the range and create a new workbook to past the data in
        rng.Copy
        Set TempWB = Workbooks.Add(1)
        With TempWB.Sheets(1)
            .Cells(1).PasteSpecial Paste:=8
            .Cells(1).PasteSpecial xlPasteValues, , False, False
            .Cells(1).PasteSpecial xlPasteFormats, , False, False
            .Cells(1).Select
            Application.CutCopyMode = False
            On Error Resume Next
            .DrawingObjects.Visible = True
            .DrawingObjects.Delete
            On Error GoTo 0
        End With
     
        'Publish the sheet to a htm file
        With TempWB.PublishObjects.Add( _
             SourceType:=xlSourceRange, _
             Filename:=TempFile, _
             Sheet:=TempWB.Sheets(1).Name, _
             Source:=TempWB.Sheets(1).UsedRange.Address, _
             HtmlType:=xlHtmlStatic)
            .Publish (True)
        End With
     
        'Read all data from the htm file into RangetoHTML
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
        RangetoHTML = ts.ReadAll
        ts.Close
        RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                              "align=left x:publishsource=")
     
        'Close TempWB
        TempWB.Close savechanges:=False
     
        'Delete the htm file we used in this function
        Kill TempFile
     
        Set ts = Nothing
        Set fso = Nothing
        Set TempWB = Nothing
    End Function
    segunda-feira, 14 de setembro de 2009 13:41
  • Fernando, Obrigado Funciona Perfeitamente VAleu mesmo

    Estava fazendo algumas mudanças para deixar Perfeita no uso.
    Tive um Problema.
    Exemplo.
    No corpo do E-mail estou tentando ajustar para enviar o conteudo da celula ("B2") e quando enviar o conteudo da celula ("B2") eu queria que enviasse o e-mail para o endereço de e-mail que consta na celula ("P2"). E na celula ("Q2") iserise uma resposta de (SIM) que este e-mail ja foi enviado.

    Se tiver Como queria fazer no restante da celulas. Mais queria que enviasse o E-mail somente se tiver coteudo na celulas da coluna ("P")

    Grato desde Ja pela Atenção Fernando
    Obrigado
    terça-feira, 15 de setembro de 2009 14:03