none
enviar email automatico quando valor da celula maior que limite 3 vezes consecutivas RRS feed

  • Pergunta

  • Muito bom!

    Pessoal tenho uma duvida acredito que similar.

    Caso possam ajudar, gostaria de enviar um email a algumas pessoas caso o valor obtido seja superior ao limite estipulado em 3 vezes consecutivas (ex 8,5 para pH). Criei até uma logica para formataçao condicional mas infelizmente desconheço a ferramenta de VBA.

    Local de Coleta Data pH  
     
     
    REPOSIÇÃO TORRE 3 22/08/2011 8,05  
    REPOSIÇÃO TORRE 3 29/09/2011 9  
    REPOSIÇÃO TORRE 3 04/10/2011 9 E(I5>$I$14;I6>$I$14;I7>$I$14)
    REPOSIÇÃO TORRE 3 13/10/2011 9 VERDADEIRO
    REPOSIÇÃO TORRE 3 17/11/2011 6,9 FALSO
    REPOSIÇÃO TORRE 3 28/11/2011 7,8 FALSO
    REPOSIÇÃO TORRE 3 07/12/2011 8 FALSO
    REPOSIÇÃO TORRE 3 22/12/2011 6,97 FALSO
        Limite  
        8,5  

    Atenciosamente,

    Rafael

     
    • Movido AndreAlvesLima quinta-feira, 15 de março de 2012 11:05 (De:Grupos de Usuários)
    quarta-feira, 14 de março de 2012 23:33

Respostas

  • Basicamente, a macro abaixo irá varrer a coluna onde você pôs as fórmulas (que estou chamando de coluna D) e irá enviar um email quando for encontrada uma célula com valor VERDADEIRO.

    A rotina abaixo só funcionará se você tiver instalado o Outlook com uma conta de e-mail configurada.

    Sub Teste()
        Dim r As Long
        With ThisWorkbook.ActiveSheet
            For r = 1 To rLast(Columns("D"))
                If Cells(r, "D") = True Then
                    EnviaEmail
                    'exit sub?
                End If
            Next r
        End With
    End Sub


    Private Sub EnviaEmail()


        Dim appOutlook As Object
        Dim olMail As Object
        
        'Verifica se Outlook está aberto. Caso não esteja, criar nova instância
        On Error Resume Next
        Set appOutlook = GetObject(, "Outlook.Application")
        If appOutlook Is Nothing Then
            Set appOutlook = CreateObject("Outlook.Application")
        End If
        On Error GoTo 0
        
        Set olMail = appOutlook.CreateItem(0) '0 é um item de e-mail
        
        With olMail
            .To = "benzadeus@ambienteoffice.com.br; felipebenza@hotmail.com"
            .Subject = "Assunto"
            .Body = "A planilha de custos foi alterada."
            .Send
        End With
    End Sub


    Private Function rLast(rng As Range) As Long
        With rng
            rLast = .Find(What:="*" _
              , After:=.Cells(1) _
              , SearchDirection:=xlPrevious _
              , SearchOrder:=xlByColumns _
              , LookIn:=xlFormulas).Row
        End With
    End Function


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quinta-feira, 15 de março de 2012 23:54
    Moderador

Todas as Respostas

  • Prezado(a),
    Estou migrando seu post para o fórum de VBA.
    Por favor, das próximas vezes que tiver alguma dúvida relacionada a esse assunto, poste por lá.
    Obrigado.

    André Alves de Lima
    Microsoft MVP - Client App Dev
    Visite o meu site: http://www.andrealveslima.com.br
    Me siga no Twitter: @andrealveslima

    quinta-feira, 15 de março de 2012 11:05
  • Basicamente, a macro abaixo irá varrer a coluna onde você pôs as fórmulas (que estou chamando de coluna D) e irá enviar um email quando for encontrada uma célula com valor VERDADEIRO.

    A rotina abaixo só funcionará se você tiver instalado o Outlook com uma conta de e-mail configurada.

    Sub Teste()
        Dim r As Long
        With ThisWorkbook.ActiveSheet
            For r = 1 To rLast(Columns("D"))
                If Cells(r, "D") = True Then
                    EnviaEmail
                    'exit sub?
                End If
            Next r
        End With
    End Sub


    Private Sub EnviaEmail()


        Dim appOutlook As Object
        Dim olMail As Object
        
        'Verifica se Outlook está aberto. Caso não esteja, criar nova instância
        On Error Resume Next
        Set appOutlook = GetObject(, "Outlook.Application")
        If appOutlook Is Nothing Then
            Set appOutlook = CreateObject("Outlook.Application")
        End If
        On Error GoTo 0
        
        Set olMail = appOutlook.CreateItem(0) '0 é um item de e-mail
        
        With olMail
            .To = "benzadeus@ambienteoffice.com.br; felipebenza@hotmail.com"
            .Subject = "Assunto"
            .Body = "A planilha de custos foi alterada."
            .Send
        End With
    End Sub


    Private Function rLast(rng As Range) As Long
        With rng
            rLast = .Find(What:="*" _
              , After:=.Cells(1) _
              , SearchDirection:=xlPrevious _
              , SearchOrder:=xlByColumns _
              , LookIn:=xlFormulas).Row
        End With
    End Function


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quinta-feira, 15 de março de 2012 23:54
    Moderador