MaximoAccess

Caro Usuário, não tire as suas duvidas nas Salas de Repositório, abra sempre um novo tópico relacionado, nas salas destinadas para o efeito, como Sala de Tabelas, Consultas, Formulários, Relatórios, Macros, Módulos e VBA.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    [Resolvido]Enviar arquivo Zipado por e-mail no mesmo evento...

    Compartilhe

    MPS
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 264
    Registrado : 19/04/2012

    [Resolvido]Enviar arquivo Zipado por e-mail no mesmo evento...

    Mensagem  MPS em 16/11/2013, 11:37

    Colegas, estou usando o código abaixo do JPaulo para zipar arquivo e preciso enviar este arquivo por e-mail no mesmo evento.
    Já tentei por Docmd.sendoject mas não funcionou.
    O Avelino tem um tutorial que usa as ferramentas do Outlook, mas a empresa não tem Outlook nos computadores, usa o Windows Live Mail.
    Existe solução pelo Docmd.sendobject ou outra, por favor?

    Public Sub ZipaBanco()
    'JPaulo  Maximo Access
    Dim strDate As String, DefPath As String
    Dim oApp As Object
    Dim FName, FileNameZip
    Dim strPrefix As String
    On Error Resume Next

    DefPath = Application.CurrentProject.Path 'Caminho da pasta onde estα o banco a zipar
    If Right(DefPath, 1) <> "\" Then
    DefPath = DefPath & "\"
    End If

    strDate = Format(Now, "dd-mmmm-yyyy_hh-mm")
    FileNameZip = DefPath & "Backup_" & strDate & ".zip"

    strPrefix = "SeuBanco" 'Nome do banco que vai ser zipado

    'FName ι o caminho da pasta onde vai ficar o banco zipado.
    'neste exemplo vai ficar junto ao proprio banco
    'Se o seu Ms Access for anterior ao 2007,
    'deve alterar a extenηγo de .accdb para .mdb
    FName = Application.CurrentProject.Path & "\" & strPrefix & ".accdb"

    On Error Resume Next
    CriaNovoZip (FileNameZip)
    Set oApp = CreateObject("Shell.Application")
    oApp.NameSpace(FileNameZip).CopyHere FName
    MsgBox "Criado com Sucesso em: " & FileNameZip
    Set oApp = Nothing
    Exit Sub
    End Sub


    Public Sub CriaNovoZip(sPath)
    'Criado pelo meu amigo e colega Raw do Canadα
    'Adaptado por JPaulo  Maximo Access
    Dim ofso, arrHex, sBin, i, Zip
    On Error Resume Next
    Set ofso = CreateObject("Scripting.FileSystemObject")
    arrHex = Array(80, 75, 5, 6, 0, 0, 0, _
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
    For i = 0 To UBound(arrHex)
    sBin = sBin & Chr(arrHex(i))
    Next
    On Error Resume Next
    With ofso.CreateTextFile(sPath, True)
    .Write sBin
    .Close
    End With
    Exit Sub
    End Sub

    Agradeço desde já!
    At
    MPS

    criquio
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 11229
    Registrado : 30/12/2009

    Re: [Resolvido]Enviar arquivo Zipado por e-mail no mesmo evento...

    Mensagem  criquio em 16/11/2013, 14:02

    Já tentou utilizar CDO? Faça uma pesquisa sobre no fórum. Há alguns exemplos.


    .................................................................................
    Meu novo site: [Você precisa estar registrado e conectado para ver este link.]

    Clique aqui e veja um vídeo que explica como fazer pesquisas no forum.


    DICA: Quando precisar inserir um exemplo do seu aplicativo, siga os procedimentos abaixo:
    1 - faça uma cópia do aplicativo
    2 - retire tudo que não for necessário à solução do problema, exceto o que o aplicativo precisar para funcionar
    3 - use o Compactar/Reparar
    4 - compacte o aplicativo em zip ou rar (zip para postagem como anexo na mensagem)


    Agradeça a quem lhe ajudou, clicando no joinha de uma das mensagens do usuário.
    Positive as mensagens que achar útil, no canto superior direito delas.


    JPaulo
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 8907
    Registrado : 04/11/2009

    Re: [Resolvido]Enviar arquivo Zipado por e-mail no mesmo evento...

    Mensagem  JPaulo em 16/11/2013, 15:04

    É como o Criquio diz, o DoCmd.SendObject só usar objectos internos, use o CDOSys:


    Sub EnviarEmail()
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")

    sEmailAddress = "email@email.com"

    iConf.Load -1 'Carrega a configuração padrão do objeto CDO
    Set Flds = iConf.Fields
    With Flds
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.live.com"
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    .Update
    End With

    strBody = "Corpo do email"

    With iMsg
    Set .Configuration = iConf
    .To = sEmailAddress
    .CC = "com cópia"
    .BCC = "cópia oculta"
    .From = "seuemail@email.com"
    .Subject = "Título do email"
    .TextBody = strBody
    .AddAttachment "C:\teste.zip"
    .Send
    End With

    'Finaliza os objetos
    Set Flds = Nothing
    Set iMsg = Nothing
    End Sub


    .................................................................................
    Sucesso e Bons Estudos
    Success and Good Studies

    [Você precisa estar registrado e conectado para ver esta imagem.] [Você precisa estar registrado e conectado para ver este link.]
    [Você precisa estar registrado e conectado para ver esta imagem.] [Você precisa estar registrado e conectado para ver este link.]
    [Você precisa estar registrado e conectado para ver esta imagem.] [Você precisa estar registrado e conectado para ver este link.]

    MPS
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 264
    Registrado : 19/04/2012

    Re: [Resolvido]Enviar arquivo Zipado por e-mail no mesmo evento...

    Mensagem  MPS em 16/11/2013, 17:16

    Criquio e JPaulo, obrigado!
    JPaulo, não consegui achar nas Propriedades de minha conta de e-mail o que seria o 2 e o 25.
    O "smtp.live.com" achei e substitui!
    Se estes 2 e 25 não são padrões, seria esta a razão para da erro de execução do .update?


    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.live.com"
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

    Agradeço desde já!
    At
    MPS

    JPaulo
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 8907
    Registrado : 04/11/2009

    Re: [Resolvido]Enviar arquivo Zipado por e-mail no mesmo evento...

    Mensagem  JPaulo em 17/11/2013, 03:50

    Eu não tenho o Live Mail, mas pelo que pesquisei funfa com a porta 587, 25 é a porta padrão.

    Aqui o codigo VBA usando o CDO.
    [Você precisa estar registrado e conectado para ver este link.]

    Aqui as config do Live.
    [Você precisa estar registrado e conectado para ver este link.]


    .................................................................................
    Sucesso e Bons Estudos
    Success and Good Studies

    [Você precisa estar registrado e conectado para ver esta imagem.] [Você precisa estar registrado e conectado para ver este link.]
    [Você precisa estar registrado e conectado para ver esta imagem.] [Você precisa estar registrado e conectado para ver este link.]
    [Você precisa estar registrado e conectado para ver esta imagem.] [Você precisa estar registrado e conectado para ver este link.]

    MPS
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 264
    Registrado : 19/04/2012

    Re: [Resolvido]Enviar arquivo Zipado por e-mail no mesmo evento...

    Mensagem  MPS em 17/11/2013, 06:43

    JPaulo, funcionou perfeitamente.
    Dica importantíssima a tua.
    Com o link aprendi que eu deveria acrescentar:
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.extensãodomeue-mail.com"
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "meue-mail"
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "minhasenha"
    Obrigado!
    At
    MPS

    JPaulo
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 8907
    Registrado : 04/11/2009

    Re: [Resolvido]Enviar arquivo Zipado por e-mail no mesmo evento...

    Mensagem  JPaulo em 17/11/2013, 11:57

    Obrigado pelo retorno o forum agradece.


    .................................................................................
    Sucesso e Bons Estudos
    Success and Good Studies

    [Você precisa estar registrado e conectado para ver esta imagem.] [Você precisa estar registrado e conectado para ver este link.]
    [Você precisa estar registrado e conectado para ver esta imagem.] [Você precisa estar registrado e conectado para ver este link.]
    [Você precisa estar registrado e conectado para ver esta imagem.] [Você precisa estar registrado e conectado para ver este link.]

      Data/hora atual: 3/12/2016, 14:42