Envio de e-mail com anexos
27/10/2015
0
abixo estou postando o código aguem sabe posso modificar este código para inserir mais de um anexo no e-mail por vez?
ub Enviar_Email(Dest As String, Copia As String, Nome As String, AnexItem As String) 'declara variaveis Dim Assunto As String, Msg As String, AnexPath As String 'atribui assunto Assunto = Range("assunto") 'atribui mensagem Msg = Range("mensagem") 'atribui caminhos dos anexos AnexPath = Range("anexos") & "\" & AnexItem 'verifica se o arquivo existe 'Set fs = CreateObject("Scripting.FileSystemObject") 'Set a = fs.fileexists(AnexPath) 'inclui o nome de destinatario na mensagem Msg = Replace(Msg, "<%Nome%>", Nome) 'inicia objeto de email do Outlook Dim oApp As Outlook.Application Dim oMailItem As Outlook.MailItem Set oApp = CreateObject("Outlook.Application") Set oMailItem = oApp.CreateItem(olMailItem) With oMailItem .Subject = Assunto .Body = Msg .To = Dest .CC = Copia If Dir(AnexPath) <> "" Then .Attachments.Add (AnexPath) .Send End With End Sub Sub Enviar_Tudo() x = 2 Do Until Range("A" & x) = "" Enviar_Email Range("B" & x), Range("C" & x), Range("A" & x), Range("D" & x) x = x + 1 Loop End Sub
Moisés
Post mais votado
28/10/2015
No primeiro link no código é criado um array vAnexos (com o range de onde estão os anexos) e depois usa o comando:
vAnexos = Application.GetOpenFilename(Title:="Anexar arquivos", MultiSelect:=True)
Que é justamente para ativar o envio de mais de um anexo.
Infelizmente se os exemplos não lhe ajudaram, sinto muito, mas tenho como sugerir mais nada.
Vamos aguardar outras sugestões e desejo-te boa sorte.
Jothaz
Mais Posts
28/10/2015
Jothaz
Anexando arquivos
http://www.hardware.com.br/comunidade/ajuste-email/1041019/
28/10/2015
Moisés
29/10/2015
Moisés
29/10/2015
Moisés
'Sub Enviar_Email(Dest As String, Copia As String, Nome As String, AnexItem As String) Sub Enviar_Email(Dest As String, Copia As String, Nome As String, Usuario As String) 'declara variaveis Dim Assunto As String, Msg As String ', AnexPath As String 'atribui assunto Assunto = Range("assunto") 'atribui mensagem Msg = Range("mensagem") 'atribui caminhos dos anexos 'AnexPath = Range("anexos") & "\" & AnexItem 'verifica se o arquivo existe 'Set fs = CreateObject("Scripting.FileSystemObject") 'Set a = fs.fileexists(AnexPath) 'inclui o nome de destinatario na mensagem Assunto = Replace(Assunto, "<%Nome%>", Nome) Msg = Replace(Msg, "<%Usuario%>", Usuario) 'inicia objeto de email do Outlook Dim oApp As Outlook.Application Dim oMailItem As Outlook.MailItem Set oApp = CreateObject("Outlook.Application") Set oMailItem = oApp.CreateItem(olMailItem) With oMailItem .Subject = Assunto .Body = Msg .To = Dest .CC = Copia 'If Dir(AnexPath) <> "" Then .Attachments.Add (AnexPath) .Attachments.Add "C:\Users\NAC\Desktop\anexo1.pdf" .Attachments.Add "C:\Users\NAC\Desktop\anexo2.pdf" .Send End With End Sub Sub Enviar_Tudo() x = 2 Do Until Range("A" & x) = "" Enviar_Email Range("B" & x), Range("C" & x), Range("A" & x), Range("D" & x) 'Enviar_Email Range("B" & x), Range("C" & x), Range("A" & x), Range("D" & x) x = x + 1 Loop End Sub
07/05/2018
Bianca
Estou com uma dificuldade imensa com VBA também não entendo nada, como faço para colocar esse código no Excel?
preciso enviar 1.800 e-mails com mais de um anexo..
Clique aqui para fazer login e interagir na Comunidade :)