• 0
Sign in to follow this  
moki

Pegar assinatura do Outlook com imagem

Question

Boa tarde, necessito da vossa ajuda.
tenho um código em VBA no access que faz o envio automático de email via outlook.
Nesse código, estou a utilizar a função GetBoiler que vai buscar a minha assinatura do outlook:

Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function

Mas acontece que a minha assinatura é constituida por texto e por uma imagem.
O código vai buscar a assinatura mas não mostra a imagem.

Já verifiquei tudo o que tinha de verificar nas "opções" do outlook e está tudo Ok. Até porque se eu envio o email normalmente a assinatura aparece com a imagem.
Podem ajudar? Preciso mesmo de resolver esta situação.
Obrigado!

Segue o código da minha função:

Function EnviarMailAutomatico()
On Error GoTo EnviarMail_Err

Dim objOut As Object
Dim objMail As Object
Dim msg As String
Dim resp As Integer
Dim MyFile
Dim SigString As String
Dim Signature As String
Dim Utilizador As String
Dim strbody As String
Const olMailItem = 0
Const olByValue = 1

Utilizador = UtilizadorRede

' Verifica se a caixa de seleção já está  selecionada
If Forms!Pedido!Enviado.Value = True Then
    MsgBox "Desculpe, mas você já  enviou este e-mail. " _
        & "Não é possível enviar o  mesmo e-mail mais " _
        & "de uma vez", vbCritical
Else

    'Retornar o nome do ficheiro da assinatura para o utilizador de rede que está logado no Computador
    MyFile = Dir("C:\Users\" & Utilizador & "\AppData\Roaming\Microsoft\Signatures\" & "*.htm")

    ' Confirmar antes de enviar o e-mail.
    resp = MsgBox("Você está prestes a  enviar um e-mail de" _
            & " confirmação de despacho.  Deseja realmente continuar?", _
            vbQuestion + vbYesNo)

    If resp = vbYes Then

        ' Cria os objetos
        Set objOut = CreateObject("Outlook.application")
        Set objMail = objOut.CreateItem(olMailItem)

   
        strbody = "<H3>Caros colegas,</H3>" & _
              "Peço que se elimine o pedido número " & Forms!Pedido!Ped & _
              ".<br>" & _
              "<br><br><B>Obrigado</B>"
        
        'Atribuir a assinatura do remetente
        SigString = Environ("appdata") & _
                "\Microsoft\Signatures\" & _
                MyFile
           
           
        If SigString <> "" Then
            Signature = GetBoiler(SigString)
        Else
            Signature = ""
        End If

        On Error Resume Next
        With objMail
         .BodyFormat = olFormatHTML
        .To = "[email protected]"
        .CC = "[email protected]"
        .Subject = "Eliminar pedido " & Forms!Pedido!Ped
      
        .HTMLBody = strbody & "<br>" & Signature
 
        End With


        ' Envia o e-mail
        objMail.Display
       
        ' Remove os objetos da memória
        Set objMail = Nothing
        Set objOut = Nothing

    End If

End If

EnviarMailAutomatico_Exit:
    Exit Function

EnviarMailAutomatico_Err:
    MsgBox Error$
    Resume EnviarMail_Exit

End Function

Edited by moki
O código estava duplicado

Share this post


Link to post
Share on other sites

0 answers to this question

Recommended Posts

There have been no answers to this question yet

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Sign in to follow this