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 = "teste@teste.pt"
.CC = "teste1@teste.pt"
.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
Pergunta
moki
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 = "teste@teste.pt"
.CC = "teste1@teste.pt"
.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
Editado por mokiO código estava duplicado
Link para o comentário
Compartilhar em outros sites
0 respostass a esta questão
Posts Recomendados
Participe da discussão
Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.