Grande Marcelo, boa tarde
Juntando umas ideias daqui outras dali testei um caminho que poderia te servir para envio dos e-mails sem o Outlook, que seria com o uso do CDO (Collaboration Data Objects) que com certeza está lá, entre suas bibliotecas do Windows.
Adaptei baseado em alguns códigos da Net, a saber, dos mestres JPaulo (por "Raw") http://www.maximoaccess.com/t477-resolvidocompactar-arquivo-pelo-access#2727, que foi a parte
da zipagem sem uso do WinZip ou outro compactador; e do conterrâneo Marcos Rieper: http://guiadoexcel.com.br/enviar-e-mail-excel-vba-planilha-de-aniversario-para-download/ a parte de enviar e-mail sem Outlook.
Marcelo, para dar uma visão mais panorâmica do código geral, deixei ele bem "seco", sem nenhum tratamento de erros nem nada e também sem loop por diversos e-mails. E como vc está trabalhando com diretórios, pastas e referências externas, o PDM (cfe. colega Fernando.Fernandes) é bem alto e com certeza vc terá que implementar.
Outro ponto a considerar é que a conversão da pasta/arquivos em .zip não usa nenhum programa (WinZip, WinRar...) e portanto o volume do arquivo praticamente não diminui ao converter. Se for realmente necessário compactar para reduzir, daria prá fazer tb. via Shell usando o nome do programa compactador q. vc tem instalado (avise se precisar).
O mais chato são os bloqueios de segurança que os próprios servidores de e-mail impõe. Por exemplo, para testar esse código com o GMail, tive que relaxar a segurança nele, ativando o "Acesso para aplicativos menos seguros" lá no site, para ele deixar de chiar.
Segue o exemplo:
Option Explicit
'Fazer referência às bibliotecas:
'Microsoft Shell Controls And Automation
'Microsoft Scripting Runtime
'Microsoft CDO for Windows 2000 Library
'Microsoft ActiveX Data Objects Recordset 6.0 Library (Opcional)
'=============================================================================
' Configurações de seu provedor e dados de sua conta de e-mails (emissor)
' Alguns itens são opcionais
Const SMTP As String = "smtp.gmail.com" 'SMTP da sua conta de email
Const PORTA As Integer = 465 'PORTA SMTP conta email envio = 465 para o gmail
Const AUTENTICAR As Boolean = True 'True/False para autenticar ou não o SMTP
Const SSL As Boolean = True 'Sua conta email possui/não possui autenticação de SSL
Const EMAIL_REM As String = "seuusuario@gmail.com" 'E-mail do remetente
Const EMAIL_SENHA As String = "suaSenha" ' Senha do e-mail emissor
Const NOME_REM As String = "Seu Nome" 'Nome remetente e-mail, se necessário
Const EMPRESA_REM As String = "Sua Empresa" 'Nome empresa que enviou, se necessário
'=============================================================================
' Configurações do receptor dos e-mails (Destinatário)
Const EMAIL_DEST As String = "destinatario@hotmail.com"
'=============================================================================
' Configurações da mensagem em si
Const TÍTULO As String = "Envio de arquivo zipado" 'título do email enviado
Const CC As String = "" 'Carbon Copy: outro(s) e-mail(s) que receberão cópia da mensagem
Const MENSAGEM As String = "Segue anexo o arquivo zipado, conforme combinado. Atte., Seu Nome."
' MENSAGEM: texto ordinário da mensagem. Desejando que seja em HTML (formatações especiais, _
figuras no corpo...) seguir a orientação do vídeo do Rieper
'=============================================================================
' Configurações do anexo
Const PastaOuArqAZipar As String = "C:UsersSeuUserNameDownloadsTeste" 'Neste caso é uma pasta inteira que será zipada
Const NOME_ANEXO As String = "C:UsersSeuUserNameDownloadsNomeZipado.zip" 'Caminho e Nome do arquivo que será zipado
'=============================================================================
Sub ZiparEEnviar()
Zipar Alvo:=PastaOuArqAZipar, ArquivoZip:=NOME_ANEXO
EnviarEMail
End Sub
Sub Zipar(Alvo As String, ArquivoZip As String)
Dim shl As Shell32.Shell: Set shl = New Shell32.Shell
Dim fso As Scripting.FileSystemObject: Set fso = New Scripting.FileSystemObject
Dim sBin As String
sBin = Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, Chr(0))
With fso.CreateTextFile(Filename:=ArquivoZip, Overwrite:=True)
.Write sBin
.Close
End With
shl.Namespace(vDir:=ArquivoZip).CopyHere Alvo
Application.Wait Time:=(Now() + 2 / 86400) 'Resolvi inserir uma pausa de 2 segundos aqui, entre a zipagem e a anexação do
'arquivo, para evitar "Erro de pastas compactadas" e/ou impedir o zip de ficar
'vazio por ele ainda estar em uso pelo outro processo
Set shl = Nothing: Set fso = Nothing
End Sub
Sub EnviarEMail()
Const Schema As String = "http://schemas.microsoft.com/cdo/configuration/"
Dim iMsg As CDO.Message: Set iMsg = New CDO.Message
Dim iConf As CDO.Configuration: Set iConf = New CDO.Configuration
Dim Flds As ADOR.Fields: Set Flds = iConf.Fields
'Caso não queira usar Early Binding c/ biblioteca ADO Recordset substituir por
'Dim Flds As Object: Set Flds = iConf.Fields
With Flds
.Item(Schema & "sendusing") = CDO.cdoSendUsingPort '= 2: Configura componente envio email
.Item(Schema & "smtpserver") = SMTP 'Configura o smtp
.Item(Schema & "smtpserverport") = PORTA 'Configura porta envio email
.Item(Schema & "smtpauthenticate") = Abs(AUTENTICAR)
.Item(Schema & "sendusername") = EMAIL_REM 'Configura email remetente
.Item(Schema & "sendpassword") = EMAIL_SENHA 'Configura senha email remetente
.Item(Schema & "smtpusessl") = Abs(SSL)
.Item(Schema & "smtpconnectiontimeout") = 60 'tempo da tentativa de conexão
.Update
End With
With iMsg
.To = EMAIL_DEST
.From = EMAIL_REM
If CC <> "" Then .CC = CC
.Subject = TÍTULO
.TextBody = MENSAGEM 'para corpo da mensagem em formato HTML, usar .HTMLBody
.Sender = NOME_REM
.Organization = EMPRESA_REM
.ReplyTo = EMAIL_REM
.AddAttachment NOME_ANEXO
Set .Configuration = iConf 'Passa a configuracao para o objeto CDO
If MsgBox(prompt:="O e-mail será enviado agora.", Buttons:=vbOKCancel, Title:="Confirmar envio") = vbOK Then
.Send 'Envia o email
End If
End With
Set iMsg = Nothing: Set iConf = Nothing: Set Flds = Nothing
End Sub
Postado : 06/03/2017 2:57 pm