COMO ENVIAR EMAILS EM PLANILHA FILTRADA NO VBA?

[BlobCat]

Pessoal, preciso de ajuda em algo que parece relativamente fácil, mas estou há dias quebrando a cabeça. Eu tenho uma planilha que uso para disparar emails para alguns contatos. Quando não recebo o comunicado deles, os status da minha planilha mudam para "PENDENTE". Eu gostaria, que essa planilha, enviasse os emails apenas para as linhas que aparecessem depois que eu filtrasse, mas ele acaba mandando para as que estão ocultas também. E para mim, não é útil que eu faça um filtro usando a palavra "PENDENTE". Gostaria que funcionasse, filtrando normalmente pela linha de títulos. Segue abaixo o código que utilizei e alguns prints da planilha.

Sub EnviarEmails()

    Application.ScreenUpdating = False
    Dim xWb As Workbook
    Dim Arquivo As String
    Dim receiver As String
    Dim cc1 As String
    Dim cc2 As String

    
    Arquivo = ActiveWorkbook.Name
    
    linha_inicial = 2
    linha = linha_inicial
    
    Do Until Workbooks(Arquivo).Sheets("2019").Cells(linha, 13) = ""
    linha = linha + 1
    Loop
    
    Size = linha - 2
    ReDim Nome(Size) As Variant
        
    
    linha = linha_inicial
    i = 0
    Do Until Sheets("2019").Cells(linha, 13) = ""
        Nome(i) = Sheets("2019").Cells(linha, 9)
        linha = linha + 1
        i = i + 1
    Loop
    
    x = RemoveDupesColl(Nome)
    
    For i = LBound(x) To UBound(x) - 1
        
        
        receiver = WorksheetFunction.VLookup(x(i), Workbooks(Arquivo).Sheets("2019").Range("I:M"), 2, False)
        cc1 = WorksheetFunction.VLookup(x(i), Workbooks(Arquivo).Sheets("2019").Range("I:M"), 3, False)
        cc2 = ""
                
        Workbooks(Arquivo).Activate
        Workbooks(Arquivo).Sheets("2019").Range("$A$" & linha_inicial - 1 & ":$M$100000").AutoFilter Field:=9, Criteria1:=x(i)
        Workbooks(Arquivo).Sheets("2019").Range("$B$" & linha_inicial - 1 & ":$M$100000").Select
        Selection.SpecialCells(xlCellTypeVisible).Select
        Selection.Copy
        
        Nome = "Controle - " & x(i) & ".xlsx"
        Set xWb = Workbooks.Add
        With xWb
            .Activate
            .Sheets("Planilha1").Paste
            .Sheets("Planilha1").Columns("A:Z").EntireColumn.AutoFit
            .Sheets("Planilha1").Range("A1").Select
            .SaveAs Filename:=Nome
            Call SendWorkbook(receiver, xWb, cc1, cc2)
            n = xWb.FullName
            .Close
            Kill (n)
        End With
        
    Next i
    
    Workbooks(Arquivo).Activate
    Workbooks(Arquivo).Sheets("2019").Range("$A$1:$M$100000").AutoFilter Field:=9
    Workbooks(Arquivo).Sheets("2019").Range("$A$1").Select
        
    Application.ScreenUpdating = True
End Sub

Sub SendWorkbook(receiver As String, xWb As Workbook, complemento As String, Optional cc1 As String, Optional cc2 As String)
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = receiver
        
        cc1 = Replace(cc1, " ", "")
        cc2 = Replace(cc2, " ", "")
        
        If cc1 <> "" And cc2 <> "" Then
            .CC = cc1 & " ; " & cc2 & "; fulano1@outlook.com"
        ElseIf cc1 = "" And cc2 = "" Then
            .CC = "fulano1@outlook.com"
        ElseIf cc1 <> "" And cc2 = "" Then
            .CC = cc1 & "; fulano1@outlook.com"
        ElseIf cc1 = "" And cc2 <> "" Then
            .CC = cc2 & "; fulano1@outlook.com"
        End If
        
        
        .BCC = ""
        .Subject = "TESTE"
        '.Body = "TESTE 2"
        
        .Body = "TESTE 3"
        .Attachments.Add xWb.FullName
        .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
    
End Sub

Function RemoveDupesColl(MyArray As Variant) As Variant
    Dim i As Long
    Dim arrColl As New Collection
    Dim arrDummy() As Variant
    Dim arrDummy1() As Variant
    Dim item As Variant
    ReDim arrDummy1(LBound(MyArray) To UBound(MyArray))

    For i = LBound(MyArray) To UBound(MyArray)
        arrDummy1(i) = CStr(MyArray(i))
    Next i
    On Error Resume Next
    For Each item In arrDummy1
       arrColl.Add item, item
    Next item
    Err.Clear
    ReDim arrDummy(LBound(MyArray) To arrColl.Count + LBound(MyArray) - 1)
    i = LBound(MyArray)
    For Each item In arrColl
       arrDummy(i) = item
       i = i + 1
    Next item
    RemoveDupesColl = arrDummy
End Function

 

[Alyson Ronnan Martins]

@BlobCat Bom dia.

Eu olhei seu código e tenho uma observação. 

Você quer que envie apenas o seu "resultado do filtro" correto?

Para contornar isso você pode mandar o vba olhar o que esta digitado.

Sabe esse comando. 

Estamos no aguardo.

[BlobCat]

Sim, no caso, quando eu filtrasse a coluna M por "PENDENTE", eu gostaria que ele enviasse emails apenas para aquelas linhas filtradas, que estão aparecendo. Só não sei como mandar o VBA fazer isso.

Editado Agosto 29, 2019 por BlobCat

[Alyson Ronnan Martins]

Bom com esse comando você manda para caso a luminha seja vazia.

linha = linha_inicial
    i = 0
    Do Until Sheets("2019").Cells(linha, 13) = ""
        Nome(i) = Sheets("2019").Cells(linha, 9)
        linha = linha + 1
        i = i + 1
    Loop

Ai a cima ele olha na coluna 13 

Tenta alterar assim

xLinhas = Sheets("SuaPlanilha").cells(Rows.count, "M").end(xlup).row

for x = 2 to xLinhas step 1
   if Sheets("SuaPlanilha").cells(x, "M").value = "Pendente"
     'aqui o comando para enviar o email
   end if
next x

Olha se consegue compreender

[BlobCat]

Desculpe, acho que me expressei mal. Adicionando essa linha, ele vai filtrar pela palavra "PENDENTE". E eu estaria usando o filtro que está na linha dos titulos. Dessa maneira, se eu quisesse mandar para as linhas A2 e A4 apenas (filtrando qualquer um dos campos dos títulos), ele enviaria, sem selecionar e enviar para o endereço de email na linha A3 que estaria oculta, devido ao filtro. Mas com esse código quando eu tento enviar a planilha filtrada, ele envia sequencialmente para a A2, A3 e A4, mesmo com a planilha filtrada e a linha A3 oculta. Originalmente, a planilha tem cerca de 60 linhas, fazendo o filtro, eu mandaria para linhas aleatórias ex: 3, 5, 7, 11, 23, 43...

Editado Agosto 29, 2019 por BlobCat

[Alyson Ronnan Martins]

já que o filtro não funcionou tentou colocar uma colocar (justamente para envio personalizador) e colocar um "x" nela. Assim quando o mando passar nessa linha iria enviar apenas para os demarcados em x

[BlobCat]

Acabaria sendo mais trabalhoso, justo pela planilha conter tantas linhas. Utilizando o filtro dos títulos, qualquer pessoa que fosse usar essa planilha, conseguiria enviar apenas para aqueles que ela quisesse. 

[Alyson Ronnan Martins]

No meu código muda apenas isso

if Rows(x).Hidden = False then
 'Comando para enviar email
end if

Apenas a parte do IF você altera ai vai olhar as linhas que estejam sendo exibidas.

[BlobCat]

Onde exatamente ele entraria no código? No If do "With OutMail"? Eu precisaria comentar ou retirar alguma linha do código?
Desculpa por tantas perguntas, essa parte da planilha está me dando tanta dor de cabeça.