Ir ao conteúdo
  • Cadastre-se
Vitor Hugo Ataide Almeida

Excel Excel - Macro avaliar valores repetidos e copiar em email

Posts recomendados

Caros, estou precisando de ajuda com uma macro.

 

Tenho uma planilha que envia e-mails automáticos com base na linha, se em determinada coluna o valor tiver abaixo de 20% ele encaminhará um email para o endereço de email contido em determinada coluna, acontece que as vezes possuem e-mails repetidos e gostaria que ele enviasse apenas um email com a informação de todas as respectivas linhas.

 

Portanto preciso de uma fórmula que avalie:

 

Se existem valores duplicados na coluna "G"

Caso sim, copie as informações das respectivas linhas em um mesmo e-mail.

 

'Enviar email
Sub Enviar_email(ByVal lLogin As String, ByVal lAR As String, ByVal lInvalidas As String, ByVal lValidas As String, ByVal lTotal As String, ByVal lPorcentagem As String, ByVal lEmail As String)
    Dim enderecos As Range
    Dim celula As Range
    Dim anexo As String
    Dim r As Integer
    Dim fim
    Dim enviar
    Dim objOlAppApp As Outlook.Application
    Dim objOlAppMsg As Outlook.MailItem
    Dim objOlAppRecip As Outlook.Recipient
    Dim objOlAppRecip2 As Outlook.Recipient
    Dim objOlAppAnexo As Outlook.Attachment
    
    'Criar objeto do outlook
    Set objOlAppApp = CreateObject("Outlook.Application")
    Set objOlAppMsg = objOlAppApp.CreateItem(olMailItem)

    With objOlAppMsg
        'Email do destinatário
        Set objOlAppRecip = .Recipients.Add("gsi@certisign.com.br")
        objOlAppRecip.Type = olTo
        Set objOlAppRecip2 = .Recipients.Add(lEmail)
        objOlAppRecip.Type = olCC
        
        'Grau de importância do email
        .Importance = olImportanceHigh
        'Cabeçalho do email
        .Subject = "[Confidencial] Manual XXXX - " & lAR
        'Texto do email
        
        
        '        .HTMLBody = "<b>À</b> <br>" _
        & "<b>XXXX  " & lTarefa & "</b>" & "<br>" & "<br>" _
        & "<b>A/C.: Sr(a)." & lPessoa & "</b>" & "<br>" _
        & lCopy & "<br>" & "<br>" _
        & "Assunto: XXXXX" & "<br>" & "<br>" _
        & "<b>XXXXXX</b>, inscrita no CNPJ nº. 0XXX, sediada na XXX, nº 9SS4, 12º andar, São Paulo/SP, CEP 000003, expõe o quanto segue anexo." & "<br>" & "<br>" & "<br>" & "<br>" _
        & "Atenciosamente," & "<br>" _
        & "Departamento XXXXs"
        '.Attachments.Add "CAMINHO DIRETÓRIO"
        '.Display
   

    'Liberar variáveis
    Set objOlAppApp = Nothing
    Set objOlAppMsg = Nothing
    Set objOlAppAnexo = Nothing
    Set objOlAppRecip = Nothing
    Set obgOlAppRecip2 = Nothing
End Sub


'Enviar emails das pendências
Sub lsEnviarAtrasos()
    Dim iTotalLinhas    As Long
    Dim i               As Long
    Dim lHoje           As Date

    Worksheets("5W2H").Select
    Cells(2, 1).Select

    iTotalLinhas = Cells(Rows.Count, 1).End(xlUp).Row + 1
    
    i = 2
    
    While i < iTotalLinhas
        If Cells(i, 6).Value >= Range("CP2").Value Then
            Enviar_email Cells(i, 1).Value, Cells(i, 2).Value, Cells(i, 3).Value, Cells(i, 4).Value, Cells(i, 5).Value, Cells(i, 6).Value, Cells(i, 7).Value
        End If
        i = i + 1
    Wend
End Sub

'Enviar emails e fechar aplicação
Sub lsValidaEnvio()

     If MsgBox("Deseja verificar as pendências e enviar por email?", vbYesNo, "Confirmar envio de email") = vbYes Then
        lsEnviarAtrasos
        
    End If
End Sub

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Para entender melhor a sua demanda, envie o arquivo ou um modelo bem próximo do original, com alguns dados fictícios

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

@Basole Segue planilha, no caso, quando os endereços de email se repetirem eu gostaria que ele enviasse apenas um, mas com todos os dados das respectivas linhas que contém esse email.

 

Atualmente ele envia 1 email para cada linha.

Email Automatc.xlsx

Compartilhar este post


Link para o post
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisar ser um membro para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora





Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

GRÁTIS: minicurso “Como ganhar dinheiro montando computadores”

Gabriel TorresGabriel Torres, fundador e editor executivo do Clube do Hardware, acaba de lançar um minicurso totalmente gratuito: "Como ganhar dinheiro montando computadores".

Você aprenderá sobre o quanto pode ganhar, como cobrar, como lidar com a concorrência, como se tornar um profissional altamente qualificado e muito mais!

Inscreva-se agora!