Ajuda com código - vba

[Raquel Penha]

Olá pessoal, tudo bem?

Sou iniciante no vba e estou lançando um projeto na minha empresa de uma macro no excel que dispara emails em massa para mandar as notas fiscais em aberto dos clientes. Desenvolvi o código primário com as informações que eu preciso. O que acontece é que 1 cliente pode possuir mais de uma nota em aberto e eu não quero que ele receba 30/40 emails cada um com uma nota. Então gostaria de saber como posso juntar todas as notas em um email com a condição de que o campo "account" (coluna G) seja o mesmo. Ou seja, se o account for o mesmo da linha de cima, na coluna G, gostaria que ele juntasse as informações das notas no mesmo email.

Se alguém puder me ajudar agradeço muito, vai garantir minha visibilidade com a minha chefe e quem sabe até um aumento haha

As informações são essas (colunas B até G):

Nome do cliente/fornecedor	SerialNfSe	Valor do Serviço	email	Link da NFse	account
adm servicos de informatica ltda	997	R$                 1.200,80	raqlast@gmail.com	https://nfe.prefeitura.sp.gov.br/contribuinte/	adm
adm servicos de informatica ltda	998	R$                 1.062,50	raqlast@gmail.com	https://nfe.prefeitura.sp.gov.br/contribuinte/	adm
ibd tecnologia da infomação ltda	994	R$                 1.516,89	raqlast@gmail.com	https://nfe.prefeitura.sp.gov.br/contribuinte/	ibd
mgh	991	R$                 3.458,33	raqlast@gmail.com	https://nfe.prefeitura.sp.gov.br/contribuinte/	mgh
syd comercio eletronico ltda	980	R$              17.737,00	raqlast@gmail.com	https://nfe.prefeitura.sp.gov.br/contribuinte/	syd

 

O código até agora é esse aqui:

Sub enviar_email()

Set objeto_outlook = CreateObject("Outlook.Application")

For linha = 11 To 15

    Set Email = objeto_outlook.createitem(0)
    
    Email.display
    
    Email.To = Cells(linha, 5).Value
    Email.cc = "mcacft@hotmail.com"
    
    Email.Subject = "Pendência de pagamento - " & Cells(linha, 7).Value
    
    Email.Body = "Olá" & Space(1) & Cells(linha, 2).Value & "," & Chr(10) & Chr(10) _
    & "Você possui a(s) seguinte(s) fatura(s) em aberto" & Chr(10) & Chr(10) _
    & "SerialNfSe    Valor do Serviço     Link da NFse" & Chr(10) _
    & Cells(linha, 3).Value & Space(18) & "R$" & Cells(linha, 4).Value & Space(12) & Cells(linha, 6) & Chr(10) _
    & "Nesse caso, você mesmo pode atualizar seu boleto e atualizar o vencimento, é só acessar o seu Módulo Faturas" & Chr(10) _
    & "Atenciosamente," & Chr(10) & "Financeiro"
    
    Email.send

Next

End Sub

[Alyson Ronnan Martins]

Boa tarde @Raquel Penha

Você já tenho o código para colocar mais de um anexo em email? (não tenho ele)

Mais eu, antes de ajudar, quero saber se o objetivo per percorrer a planilha para encontrar o mesmo nome do cliente (ou email) e assim montar um único email.

[Raquel Penha]

Oi @Alyson Ronnan Martins tudo bem?

Não, mas não estou anexando nada aos emails.
O código já está puxando as informações do nº da nota, valor e link no corpo do email, o que preciso é que quando o campo "account" for igual ele puxe os dados e adicione no mesmo corpo de email. Por exemplo, na planilha tenho 2 accounts iguais, mas pelo meu código, o cliente vai receber 2 emails, 1 pra cada nota. Preciso que ele receba 1 emails pras 2 notas. E se um cliente tiver 30 notas, por exemplo, quero que ele receba 1 email com as informações (nº, valor e link) das 30 notas, e não 30 emails diferentes.

Estou colocando em anexo como está o corpo do email com as informações desse código que criei.

Me avise se precisar de mais alguma informação 🙂

[Alyson Ronnan Martins]

Eu criei uma lista para simular o preenchimento dos campos e envio do e-mail:

Aqui o código:

Public Sub cRaquel_Penha()
Dim accountArray() As Variant
Dim acountName As String
Dim acountFirst As Boolean
Dim lAcount As Long

'Variáveis para enviar o email:
Dim emailTO As String
Dim emailCC As String
Dim emailBody As String

With Sheets("Plan1")
    lAcount = .Cells(rows.Count, "F").End(xlup).row
    accountArray = .range("A2:F" & lAcount).Value
End With

'Remove as accounts dulplicadas
listAccount = ArrayRemoveDups(accountArray)

'Começa a montar a lista de emails olhando para a lista de "accounts"
For y = LBound(listAccount) To UBound(listAccount) Step 1
    acountName = listAccount(y)
    acountFirst = True
    For x = LBound(accountArray) To UBound(accountArray) Step 1
    
        'Procura os dados da a lista
        If accountArray(x, 6) = accountName Then
            
            'Se for a primeira vez fazer o início do email
            If acountFirst Then
                emailTO = accountArray(x, 4)
                emailCC = "mcacft@hotmail.com"
                emailBody = "Olá" & Space(1) & Cells(linha, 2).Value & "," & Chr(10) & Chr(10) _
                            & "Você possui a(s) seguinte(s) fatura(s) em aberto" & Chr(10) & Chr(10) _
                            & "SerialNfSe    Valor do Serviço     Link da NFse" & Chr(10)
                acountFirst = False
            End If
            
            'Essa parte acho melhor fazer uma tabela
            'porém estou seguindo a ideia do código
            emailBody = emailBody & accountArray(x, 2) & Space(18) & "R$" & accountArray(x, 2) & _
                        Space(12) & accountArray(x, 5)
            
        End If
    Next x
    'Fechando o email.
    emailBody = emailBody & Chr(10) _
    & "Nesse caso, você mesmo pode atualizar seu boleto e atualizar o vencimento, é só acessar o seu Módulo Faturas" & Chr(10) _
    & "Atenciosamente," & Chr(10) & "Financeiro"
    
    'Área para envioar o email:
    
    'Coloca seu código aqui
    
    'Final do Envio do email:
    
Next y
End Sub


Function ArrayRemoveDups(MyArray As Variant) As Variant
    Dim nFirst As Long, nLast As Long, i As Long
    Dim item As String
    
    Dim arrTemp() As String
    Dim Coll As New Collection

    'Get First and Last Array Positions
    nFirst = LBound(MyArray)
    nLast = UBound(MyArray)
    ReDim arrTemp(nFirst To nLast)

    'Convert Array to String
    For i = nFirst To nLast
        arrTemp(i) = CStr(MyArray(i, 1))
    Next i
    
    'Populate Temporary Collection
    On Error Resume Next
    For i = nFirst To nLast
        Coll.Add arrTemp(i), arrTemp(i)
    Next i
    Err.Clear
    On Error GoTo 0

    'Resize Array
    nLast = Coll.Count + nFirst - 1
    ReDim arrTemp(nFirst To nLast)
    
    'Populate Array
    For i = nFirst To nLast
        arrTemp(i) = Coll(i - nFirst + 1)
    Next i
    
    'Output Array
    ArrayRemoveDups = arrTemp

End Function

Agora precisa testar ou olhar o código se é mais ou menos isso que estava pensando.

 

Link: Planilha no Google Drive

 

[Raquel Penha]

@Alyson Ronnan Martins Muito obrigada pela ajuda!! Me adiantou demaaais! Deu tudo certo e já estou rodando no meu computador. Uma dúvida, aqui você comentou que seria melhor fazer como tabela, isso seria possível?

Em 06/06/2021 em 21:50, Alyson Ronnan Martins disse:

'Essa parte acho melhor fazer uma tabela
            'porém estou seguindo a ideia do código
            emailBody = emailBody & accountArray(x, 2) & Space(18) & "R$" & accountArray(x, 2) & _
                        Space(12) & accountArray(x, 5)
            

 

[Alyson Ronnan Martins]

Boa noite.

Usando código HTML você consegue formatar o email deixando mais "bonito". Não muda o fato que o resultado é o mesmo, porêm sempre que termino uma código de email VBA (e deixo funcionando) eu já coloco formatação HTML para deixar parecido com uma tabela excel e deixando mais organizado  os itens.