MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

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

    [Resolvido]Enviar e-mail CDO. com anexo com origem em registro em uma tabela do sistema

    Compartilhe

    ernandofc
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 13
    Registrado : 21/10/2015

    [Resolvido]Enviar e-mail CDO. com anexo com origem em registro em uma tabela do sistema

    Mensagem  ernandofc em 4/12/2018, 08:06

    Olá,

    Mais uma vez peço a ajuda de todos. O código abaixo serve para enviar um e-mail via CDO com anexo. Quando eu informo em uma variável a origem do arquivo que será anexado e defino a variável como string, ele funciona muito bem. O arquivo é enviado.

    Entretanto, agora, este botão está em um formulário, e este formulário baseado em uma tabela. Esta tabela possui um campo do tipo anexo. Quero enviar este anexo que está baseado em uma tabela, que está no formulário.

    O anexo está sendo enviado, mas como "Anexo sem título.dat". Alguém sabe como enviar o anexo baseado em uma tabela, e não baseado em um diretório no sistema?

    --------------------------------------------
    Código:


    Private Sub Comando1_Click()

    On Error GoTo erromail


    Dim Mens As CDO.Message
    Dim Config As CDO.Configuration
    Set Mens = CreateObject("CDO.Message")
    Set Config = CreateObject("CDO.Configuration")


    With Config

    .Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "email-ssl.com.br"
    .Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
    .Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    .Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = "pipelab@instrulab.com.br"
    .Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "XX"
    .Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
    .Fields.Update

    End With

    Set Mens = New CDO.Message
    With Mens
    Set .Configuration = Config
    .from = """Ernando | Instrulab Equipamentos e Serviços"" <pipelab@instrulab.com.br>"
    .Sender = "ernando.custodio@instrulab.com.br"
    .CC = "ernando.custodio@instrulab.com.br"
    .BodyPart.Charset = "utf-8"
    .subject = "Seja bem-vindo a Instrulab: Equipamentos e serviços para Laboratórios"
    .HTMLBody = ""
    .To = "ernando.custodio@instrulab.com.br"
    .AddAttachment (Me.Anexo)
    .Send

    End With

    Set Mens = Nothing
    Set Config = Nothing


    erromail:
    If Err.Number = 13 Then
       Resume Next
    ElseIf Err.Number = -2147220979 Then

       MsgBox "Você inseriu um endereço de email inválido ou inexistente." & vbCrLf & "Verifique o email e tente novamente.", vbOKOnly + vbCritical, "Email inválido"

    Else
       Resume Next
    End If
    avatar
    JPaulo
    Moderador
    Moderador

    Respeito às Regras 100%

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

    Re: [Resolvido]Enviar e-mail CDO. com anexo com origem em registro em uma tabela do sistema

    Mensagem  JPaulo em 7/12/2018, 08:50

    Olá;

    Só não estou a entender se o seu campo na tabela é tipo anexo mesmo.

    É tipo anexo ou texto ?


    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

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

    Ou ainda: Aqui (Novo)

    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.]

    ernandofc
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 13
    Registrado : 21/10/2015

    Re: [Resolvido]Enviar e-mail CDO. com anexo com origem em registro em uma tabela do sistema

    Mensagem  ernandofc em 7/12/2018, 08:52

    Bom dia, Paulo

    O tipo do campo é anexo.
    avatar
    JPaulo
    Moderador
    Moderador

    Respeito às Regras 100%

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

    Re: [Resolvido]Enviar e-mail CDO. com anexo com origem em registro em uma tabela do sistema

    Mensagem  JPaulo em 7/12/2018, 09:22

    Ok;

    Sendo anexo, não funciona como esperado.

    Há tempos coloquei aqui um exemplo de exportar anexos, vou ver se encontro.

    A solução é você exportar o anexo, e depois anexar ao email.

    Aguarde...


    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

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

    Ou ainda: Aqui (Novo)

    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.]
    avatar
    JPaulo
    Moderador
    Moderador

    Respeito às Regras 100%

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

    Re: [Resolvido]Enviar e-mail CDO. com anexo com origem em registro em uma tabela do sistema

    Mensagem  JPaulo em 7/12/2018, 09:24

    O exemplo é este:

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



    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

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

    Ou ainda: Aqui (Novo)

    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.]
    avatar
    JPaulo
    Moderador
    Moderador

    Respeito às Regras 100%

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

    Re: [Resolvido]Enviar e-mail CDO. com anexo com origem em registro em uma tabela do sistema

    Mensagem  JPaulo em 7/12/2018, 09:36

    Diga-me por favor qual o nome da sua tabela onde está esse campo Anexo e o nome do campo.


    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

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

    Ou ainda: Aqui (Novo)

    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.]
    avatar
    JPaulo
    Moderador
    Moderador

    Respeito às Regras 100%

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

    Re: [Resolvido]Enviar e-mail CDO. com anexo com origem em registro em uma tabela do sistema

    Mensagem  JPaulo em 7/12/2018, 10:44

    Altere para os nomes corretos da sua tabela e campo anexo;

    Teste e retorne por favor.


    Código:
    Private Sub Comando1_Click()
    'By JPaulo maximoaccess
        Dim dbs As DAO.Database
        Dim rst As DAO.Recordset
        Dim rstAnexos As DAO.Recordset
        Dim strCaminho As String
        Dim Mens As CDO.Message
        Dim Config As CDO.Configuration
        
    On Error GoTo erromail

    strCaminho = ""
         Set dbs = CurrentDb
         'abre o recordset á tabela filtrando pelo nome do anexo
         Set rst = dbs.OpenRecordset("SELECT * FROM SuaTabela WHERE SeuCampoAnexo='" & Me.SeuCampoAnexo & "'")
    'se não existirem registros morre aqui
        If rst.RecordCount = 0 Then Exit Sub
        
    With rst
    'inicia o loop á tabela
    Do Until .EOF
    'seta a variavel rstAnexos com o nome do anexo na tabela
        Set rstAnexos = rst.Fields("SeuCampoAnexo").Value
        While Not rstAnexos.EOF
    'salva o anexo junto do banco
    'eliminamos a mensagem de erro se já existir o ficheiro
    On Error Resume Next
         rstAnexos.Fields("FileData").SaveToFile CurrentProject.Path & "\"
    'escrevo na variavel o caminho do anexo, para usar no email
         strCaminho = CurrentProject.Path & "\" & Me.Anexo_FileName
    'avança para novo registro se existir
         rstAnexos.MoveNext
        Wend
       .MoveNext
    Loop
    End With
    'fecha o recordset e limpa a memoria
    rst.Close: Set rst = Nothing
    'fecha o database e limpa a memoria
    dbs.Close: Set dbs = Nothing

    Set Mens = CreateObject("CDO.Message")
    Set Config = CreateObject("CDO.Configuration")

    With Config

    .Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "email-ssl.com.br"
    .Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
    .Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    .Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = "pipelab@instrulab.com.br"
    .Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "XX"
    .Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
    .Fields.Update

    End With

    Set Mens = New CDO.Message

    With Mens
    Set .Configuration = Config
        .From = """Ernando | Instrulab Equipamentos e Serviços"" <pipelab@instrulab.com.br>"
        .Sender = "ernando.custodio@instrulab.com.br"
        .CC = "ernando.custodio@instrulab.com.br"
        .BodyPart.Charset = "utf-8"
        .Subject = "Seja bem-vindo a Instrulab: Equipamentos e serviços para Laboratórios"
        .HTMLBody = ""
        .To = "ernando.custodio@instrulab.com.br"

    'adicionamos o anexo exportado
        If Nz(strCaminho, "") <> "" Then .AddAttachment ("file://" & strCaminho)
        
    'se não funcionar, comente a linha de cima e teste assim;
    '    If Nz(strCaminho, "") <> "" Then .AddAttachment strCaminho

        .Send
    End With

    Set Mens = Nothing
    Set Config = Nothing

    'deletamos o anexo exportado
    Kill strCaminho

    erromail:
    If Err.Number = 13 Then
       Resume Next
    ElseIf Err.Number = -2147220979 Then

       MsgBox "Você inseriu um endereço de email inválido ou inexistente." & vbCrLf & "Verifique o email e tente novamente.", vbOKOnly + vbCritical, "Email inválido"

    Else
       Resume Next
    End If
    End Sub


    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

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

    Ou ainda: Aqui (Novo)

    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.]

    ernandofc
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 13
    Registrado : 21/10/2015

    Re: [Resolvido]Enviar e-mail CDO. com anexo com origem em registro em uma tabela do sistema

    Mensagem  ernandofc em 11/12/2018, 13:47

    Perfeito, Paulo. Funcionou perfeitamente. Muito obrigado.
    avatar
    JPaulo
    Moderador
    Moderador

    Respeito às Regras 100%

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

    Re: [Resolvido]Enviar e-mail CDO. com anexo com origem em registro em uma tabela do sistema

    Mensagem  JPaulo em 11/12/2018, 14:23

    Fico feliz
    Obrigado pelo retorno o fórum agradece.


    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

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

    Ou ainda: Aqui (Novo)

    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: 16/12/2018, 07:01