Jump to content
Fórum Script Brasil
  • 0

Ajuda com código - vba


Question

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 [email protected] https://nfe.prefeitura.sp.gov.br/contribuinte/ adm
adm servicos de informatica ltda 998  R$                 1.062,50 [email protected] https://nfe.prefeitura.sp.gov.br/contribuinte/ adm
ibd tecnologia da infomação ltda 994  R$                 1.516,89 [email protected] https://nfe.prefeitura.sp.gov.br/contribuinte/ ibd
mgh 991  R$                 3.458,33 [email protected] https://nfe.prefeitura.sp.gov.br/contribuinte/ mgh
syd comercio eletronico ltda 980  R$              17.737,00 [email protected] 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 = "[email protected]"
    
    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

Link to post
Share on other sites

3 answers to this question

Recommended Posts

  • 0

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 🙂

Captura de tela 2021-06-06 143553.png

Link to post
Share on other sites
  • 0

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

image.png.92ec1f6684112a045c834dc15acf0b7c.png

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 = "[email protected]"
                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

 

Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.



  • Forum Statistics

    • Total Topics
      149405
    • Total Posts
      645894
×
×
  • Create New...