Ir para conteúdo
Fórum Script Brasil

Leonardo Cardoso

Membros
  • Total de itens

    1
  • Registro em

  • Última visita

Sobre Leonardo Cardoso

Leonardo Cardoso's Achievements

0

Reputação

  1. 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
×
×
  • Criar Novo...