Ir para conteúdo
Fórum Script Brasil
  • 0

Uso correto do Loop


Leonardo Cardoso

Pergunta

Pessoal, tenho uma macro que anexa 1 arquivo em um email . Esse arquivo possui um número de identificação.

Com esse mesmo número, uma outra macro seleciona um intervalo de células, copia e cola no mesmo email, só que como imagem, no corpo do email.

Acontece que antes, eram duas macros separadas, foi preciso juntar as duas e ai começa o problema. O loop que anexa os arquivos não funciona mais e eu precisava de um loop para selecionar as imagens também. Será que alguém pode me ajudar? Primeiro anexa o arquivo e depois cola a imagem no corpo do e-mail.

Segue a macro abaixo.

Sub Botão1_Clique()

    Sheets("LISTA_VALIDADA").Select
    Range("B2").Select

    Dim NOME_ARQUIVO(1 To 290) As String
    Dim ENVIAR_PARA(1 To 290) As String
    Dim ENVIAR_COPIA(1 To 290) As String
    Dim NOME_REVENDA(1 To 290) As String
    Dim NOME As String
    Dim I As Integer
    Dim y As Integer
    I = 2
    y = 2
    X = 1
    Do While Cells(I, 1).Value <> ""
     
    NOME_ARQUIVO(X) = Cells(I, 2).Value
    ENVIAR_PARA(X) = Cells(I, 3).Value
    ENVIAR_COPIA(X) = Cells(I, 4).Value
 
  NOME = "C:\OSAB\" & "\OSAB_" & NOME_ARQUIVO(X) & ".xlsx"
    
  Set oOutlook = GetObject(, "Outlook.Application")
  If oOutlook Is Nothing Then Set oOutlook = CreateObject("Outlook.Mailer")
  Set oEmailItem = oOutlook.CreateItem(olMailItem)
  
  With oEmailItem

    .Attachments.Add NOME
     .SentOnBehalfOfName = "PP-Planejamento e Performance RCO <PP-PlanejamentoePerformanceRCO@oi.net.br>"
    .To = ENVIAR_PARA(X)
    .cc = ENVIAR_COPIA(X)
    .Subject = "OSAB " & NOME_ARQUIVO(X)
           
   .Display
   
 Sheets("Visão_Produto").Select
 Dim Seleto1 As String
 Seleto1 = Sheets("Visão_Produto").Range("CV8").Value
 
 ActiveSheet.PivotTables("Tabela dinâmica1").PivotFields("CANAL_LOCAL").ClearAllFilters
 ActiveSheet.PivotTables("Tabela dinâmica1").PivotFields("PDV_SAP").CurrentPage = Seleto1
 
 Range("B12:Y68").CopyPicture Appearance:=xlScreen, Format:=xlBitmap
 
 Set OCht01 = ActiveSheet.ChartObjects.Add(50, 50, Worksheets("Visão_Produto").Range("B12:Y68").Width, Worksheets("Visão_Produto").Range("B12:Y68").Height).Chart
OCht01.Paste
OCht01.Export Filename:="P:\Gustavo\Prints\Print_1.jpg", filtername:="JPG"
ActiveChart.Parent.Delete

.HTMLBody = "Bom dia, Prezado Parceiro! " & vbCrLf & vbCrLf & _
    "<BR><BR>" & _
    "Segue o OSAB de Fixo, Velox e TV." & vbCrLf & vbCrLf & _
    "<BR><BR>" & _
    "Qualquer dúvida, favor entrar em contato com o seu Gerente de Contas! Esse email não envia respostas." & vbCrLf & vbCrLf & _
    "<BR><BR>" & _
    "Att," & vbCrLf & vbCrLf & _
    "<BR><BR>" & _
   "PLANEJAMENTO E PERFORMANCE CO" & vbCrLf & _
   "<BR><BR>" & _
   "Dir Vendas Varejo" & _
   "<BR><BR>" & _
     "<img src='P:\Gustavo\Prints\Print_1.jpg'>"
     
     .Display
  
End With

X = X + 1
I = I + 1

Loop

  Dim RESPOSTA
  RESPOSTA = MsgBox("Emails enviados com sucesso!", vbInformation)

    Sheets("BUTTON").Select
    Range("A2").Select


End Sub

Link para o comentário
Compartilhar em outros sites

0 respostass a esta questão

Posts Recomendados

Até agora não há respostas para essa pergunta

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,5k
×
×
  • Criar Novo...