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.
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 = "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)
Pergunta
Leonardo Cardoso
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
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.