Notifications
Clear all

Compactar pasta e enviar por email sem uso do outlook

2 Posts
2 Usuários
0 Reactions
1,041 Visualizações
(@mprudencio)
Posts: 0
New Member
Topic starter
 

Boa tarde, o titulo ja diz tudo.

Preciso compactar (ZIP, Rar) uma determinada pasta que esta em C: e enviar essa pasta por email, porem não tenho outlook no pc entao gostaria de fazer isso sem o uso dele.

No email teria uma mensagem pre definida e os emails ja estariam pre definidos na planilha.

Alguem poderia dar essa força

 
Postado : 04/03/2017 12:58 pm
(@edsonbr)
Posts: 0
New Member
 

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