jeversong2014
Mensagens : 13
Data de inscrição : 29/04/2014
Idade : 31
 | | Assunto: envio de e-mail utilizando recursos do VBA Qua Jul 30, 2014 10:23 pm | |
| boa tarde, utilizo o Excel para enviar e-mails via outlook. Utilizo uma sub que copia os dados da planilha matriz que eu especifiquei e cola numa nova planilha em excel, utilizo uma variavel que renomeia esta nova planilha e salva num caminho da rede, em seguida utilizo outra sub que anexa esta nova planilha com o nome especificado e envia para os destinatários correspondentes via e-mail. isso vem funcionando muito bem, mas preciso agora que além dessa planilha sejam anexados neste e-mail outros arquivos sem nome especificado, todos esses arquivos são de extensão .TIF (serão sempre no máximo 20 arquivos.TIF) e diariamente os arquivos serão diferentes. pergunto se alguém sabe se é possivel fazer isso? e como encaixo na minha sub: - Código:
-
Sub preparardados()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
DEVOL = ActiveWorkbook.Name
Sheets("DEVOLVER").Select
Range("A2:Q11").Select
Selection.Copy
Workbooks.Open Filename:="C:\temp\NOVAPLANILHA.XLSX"
Sheets("ENVIAR").Select
Range("A1").Select
ActiveSheet.Paste
ActiveWorkbook.SaveAs Filename:="C:\temp\NOVAPLANILHA.XLSX"
ActiveWindow.Close
ARQ = "C:\temp\NOVAPLANILHA.XLSX"
'ABRE NOVAMENTE A MATRIZ DE DADOS
Windows(DEVOL).Activate
'VAI PARA NOVA SUB
Call Email(i, arq_novo)
MsgBox ("E-mail enviado")
END SUB
---------------------------------------------------------------------------------------
Sub Email(i, arq_novo)
ARQ = "C:\temp\NOVAPLANILHA.XLSX"
'AQUI TENTEI CRIAR UMA VARIAVEL MAS NAO DEU CERTO
'Imagens = "C:\TEMP\*.TIF"
Dim out, mail As Object
Dim PARA1, PARA2, ASSUNTO, TEXTO1, TEXTO2 As String
Dim ANEXO1 As String
Set out = CreateObject("outlook.application")
Set mail = out.CreateItem(olMailItem)
mail.SentOnBehalfOfName = "fulano@hotmail.com.br"
PARA = Sheets("E-MAIL").Range("B8")
CCOPIA = Sheets("E-MAIL").Range("B9")
ASSUNTO = (Sheets("E-MAIL").Range("B10")) & COOP
TEXTO1 = (Sheets("E-MAIL").Range("B11"))
'ASSINATURA
nome = Sheets("E-MAIL").Range("B17")
cargo = Sheets("E-MAIL").Range("B18")
area = Sheets("E-MAIL").Range("B19")
empresa = Sheets("E-MAIL").Range("B20")
contato = Sheets("E-MAIL").Range("B21")
If Hour(Now()) >= 12 And Hour(Now()) < 19 Then
saudação = "Boa tarde"
ElseIf Hour(Now()) >= 19 And Hour(Now()) <= 6 Then
saudação = "Boa noite"
Else
saudação = "Bom dia"
End If
mail.To = PARA
mail.CC = CCOPIA
mail.Subject = ASSUNTO
mail.Body = saudação & "," & Chr(13) & Chr(13) _
& TEXTO1 & Chr(13) _
& "Att" & Chr(13) _
& nome & Chr(13) _
& cargo & Chr(13) _
& area & Chr(13) _
& empresa & Chr(13) _
& contato
mail.attachments.Add ARQ
'aqui adicionaria a a variavel "imagens" que seriam os arquivos .tif que eu necessito
'mail.attachments.Add Imagens
mail.display
On Error Resume Next
mail.Send
On Error GoTo 0
Set out = Nothing
End Sub
| |
|
