Notifications
Clear all

Resumir IF , else e fazer um loop

4 Posts
2 Usuários
0 Reactions
814 Visualizações
(@fazerbem)
Posts: 0
New Member
Topic starter
 

Sera que os amigos aqui poderiam me fazer um loop aqui pra la em baixo parar de ficar repetido o IF, Else

Vou explicar, minha coluna C sera usada para os emails dos clientes, entao sempre esta aba estara sempre classificada de A a Z de maneira todos os clientes que tiverem emails ficarao em cima, e abaixo destes os clientes sem email. quando houver um novo cadastro la em baixo, e este contiver um email, dai classifico novamente de A a Z e todos os clientes com email ficarao agrupados novamente. Entao quando esta macro rodar ela vai rodar até o ultimo cliente da lista em que a Coluna C estiver com o email do cliente.

Teria como me ajeitar ela pra nao ter que encher de IF Else ?

Sub Enviar_Avisos()

'Baseado no código disponibilizado em: http://www.a1vbcode.com/snippet-3691.asp
'Function EnviaEmail2()
    Dim iMsg, iConf, Flds
 
    'Seta as variáveis, lembrando que o objeto Microsoft CDO deverá estar habilitado em Ferramentas->Referências->Microsoft CDO for Windows 2000 Library
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
    Set Flds = iConf.Fields
 
    'Configura o componente de envio de email
    schema = "http://schemas.microsoft.com/cdo/configuration/"
    Flds.Item(schema & "sendusing") = 2
    'Configura o smtp
    Flds.Item(schema & "smtpserver") = "smtp.gmail.com"
    'Configura a porta de envio de email
    Flds.Item(schema & "smtpserverport") = 465
    Flds.Item(schema & "smtpauthenticate") = 1
    'Configura o email do remetente
    Flds.Item(schema & "sendusername") = "SEU EMAIL@gmail.com"
    'Configura a senha do email remetente
    Flds.Item(schema & "sendpassword") = "SENHA"
    Flds.Item(schema & "smtpusessl") = 1
    Flds.Update
  
  Dim Cliente As String
  Cliente = Range("C7")
  
Voltar:
 
    With iMsg
        'Email do destinatário
        .To = Cliente
        'Seu email
        .From = "SEU EMAIL@gmail.com"
        'Título do email
        .Subject = Range("F5").Value
        'Mensagem do e-mail, você pode enviar formatado em HTML
        .HTMLBody = Range("F7").Value & "<br>" & _
                    Range("F9").Value & "<br>" & _
                    Range("F11").Value & "<br>" & _
                    Range("F13").Value & "<br>" & _
                    Range("F15").Value & "<br><br>" 
 
        'Seu nome ou apelido
        .Sender = "Suplementos FazerBem"
        'Nome da sua organização
        .Organization = "Suplementos FazerBem"
        'email de responder para
        .ReplyTo = "SEU EMAIL@gmail.com"
        'Anexo a ser enviado na mensagem
       ' .AddAttachment ("c:fatura.txt")
        'Passa a configuração para o objeto CDO
        Set .Configuration = iConf
        'Envia o email
        .Send
    End With
 
 If Range("C8").Value <> "" Then
   Cliente = Range("C8")
   GoTo Voltar
Else
GoTo Fim:
   End If
   
 If Range("C9").Value <> "" Then
   Cliente = Range("C9")
   GoTo Voltar
Else
GoTo Fim:
   End If
   
 If Range("C10").Value <> "" Then
   Cliente = Range("C10")
   GoTo Voltar
Else
GoTo Fim:
   End If
   
Fim:
 
 
    'Limpa as variáveis
    Set iMsg = Nothing
    Set iConf = Nothing
    Set Flds = Nothing
'End Function



End Sub
 
Postado : 13/09/2016 2:22 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Não sei se entendi corretamente, mas experimente:

Sub Enviar_Avisos()
'Baseado no código disponibilizado em: http://www.a1vbcode.com/snippet-3691.asp
Dim iMsg, iConf, Flds
    'Seta as variáveis, lembrando que o objeto Microsoft CDO deverá estar habilitado em Ferramentas->Referências->Microsoft CDO for Windows 2000 Library
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
    Set Flds = iConf.Fields

    'Configura o componente de envio de email
    schema = "http://schemas.microsoft.com/cdo/configuration/"
    Flds.Item(schema & "sendusing") = 2
    'Configura o smtp
    Flds.Item(schema & "smtpserver") = "smtp.gmail.com"
    'Configura a porta de envio de email
    Flds.Item(schema & "smtpserverport") = 465
    Flds.Item(schema & "smtpauthenticate") = 1
    'Configura o email do remetente
    Flds.Item(schema & "sendusername") = "SEU EMAIL@gmail.com"
    'Configura a senha do email remetente
    Flds.Item(schema & "sendpassword") = "SENHA"
    Flds.Item(schema & "smtpusessl") = 1
    Flds.Update
Dim Cliente As String
Dim x As Integer
Do While Range("C" & x) <> ""
x = 7
Cliente = Range("C" & x)
  With iMsg
    'Email do destinatário
    .To = Cliente
    'Seu email
    .From = "SEU EMAIL@gmail.com"
    'Título do email
    .Subject = Range("F5").Value
    'Mensagem do e-mail, você pode enviar formatado em HTML
    .HTMLBody = Range("F7").Value & "<br>" & _
                Range("F9").Value & "<br>" & _
                Range("F11").Value & "<br>" & _
                Range("F13").Value & "<br>" & _
                Range("F15").Value & "<br><br>"
    'Seu nome ou apelido
    .Sender = "Suplementos FazerBem"
    'Nome da sua organização
    .Organization = "Suplementos FazerBem"
    'email de responder para
    .ReplyTo = "SEU EMAIL@gmail.com"
    'Anexo a ser enviado na mensagem
    '.AddAttachment ("c:fatura.txt")
    'Passa a configuração para o objeto CDO
    Set .Configuration = iConf
    'Envia o email
    .Send
End With
x = x + 1
Loop

'Limpa as variáveis
Set iMsg = Nothing
Set iConf = Nothing
Set Flds = Nothing
End Sub
 
Postado : 13/09/2016 4:47 pm
(@fazerbem)
Posts: 0
New Member
Topic starter
 

Boa noite Reinaldo, amanha eu testo, mas certo que vai dar certo.

Grato

Amanha vou ver se mando uma plan com um erro que ta me deixando louco, pois estando na useform e ao rodar a macro e puxando uma plan, a tela fica presa, não sei mas o que fazer. Falei disso num outro topico, mas como ninguem ainda me deu uma solucao, creio que o filho e feio mesmo.

 
Postado : 13/09/2016 5:22 pm
(@fazerbem)
Posts: 0
New Member
Topic starter
 

Era exatamente isso que eu queria, grato Reinaldo.

Apenas troquei de lugar o x=7

Dim x As Integer
Do While Range("C" & x) <> ""
x = 7

para

Dim x As Integer
x = 7
Do While Range("C" & x) <> ""

Abraços

 
Postado : 14/09/2016 5:31 am