Prezados,
Estou com problema para enviar email em num de meus formulários, acredito que foi depois que mudei para Windows 64 bits. Agradeço o suporte
Links - Tela erro
mega.nz/#!wmYjhJba!4X-uAfcO04MIUIdKWKGZVhWHkfaeClyW0VX5R72_Q5g
mega.nz/#!5zZQRR7A!xQuA-OA0IAjfCSPglo6RwEe6z5_qjTg2TRHH0dLyy6E
Private Sub btEnviarProposta_Click()
Dim strArquivo As String
Dim strLocal As String
Dim objOut As Object
Dim objmail As Object
Dim objAnexo As Object
Const olMailItem = 0
Const olByValue = 1
'-----------------------------------------------------------------------------
'verifica se existe endereço de email. Caso não exista. aborda procedimento.
'-----------------------------------------------------------------------------
If IsNull(Me!Email_P) Then
MsgBox "Está faltando o endereço de email Principal...", vbInformation, "Aviso"
Exit Sub
End If
If IsNull(Me!Email_S) Then
MsgBox "Está faltando o endereço de email Secundario...", vbInformation, "Aviso"
Exit Sub
End If
Set objOut = CreateObject("Outlook.application")
Set objmail = objOut.CreateItem(olMailItem)
Set objAnexo = objmail.Attachments
strArquivo = "FATURA - " & Me!FATURA & " - " & Me!DescriçãoGeral & ".pdf"
strLocal = CurrentProject.Path & "\.\" & strArquivo
If Me.Dirty Then DoCmd.RunCommand acCmdSaveRecord
DoCmd.OpenReport "fatura_com", acViewPreview, , "Fatura = " & Me!FATURA, acHidden
DoCmd.OutputTo acOutputReport, "fatura_com", acFormatPDF, strLocal
DoCmd.Close acReport, "fatura_com"
objAnexo.Add strLocal, olByValue, 1
strAssunto = "COBRANÇA HT LOGÍSTICA - Fatura Referente a " & StrConv(Format(Me!DescriçãoGeral), vbProperCase) & "."
strCorpo = StrConv(Format(Me!Saudacao), vbProperCase) & "
Prezado(a)s!
Segue anexo a fatura: " & StrConv(Format(Me!FATURA), vbProperCase) & ", referente a intermediação de serviços postais " & StrConv(Format(Me!DescriçãoGeral), vbProperCase)
strCorpo = strCorpo & ", com vencimento para " & Me!DT_VENCIMENTO & " no valor total de R$ " & (Format(Me!Total)) & ".
"
strCorpo = strCorpo & "Ficamos à disposição para quaisquer esclarecimentos, podendo atendê-lo a com a devida presteza.
*Favor confirmar o recebimento." & "
"
strCorpo = strCorpo & "AVISO:
Gentileza verificar as atualizações de prazo e informativos no portal dos CORREIOS
1.http://correios.com.br/para-voce/avisos
2.http://correios.com.br/para-voce/precisa-de-ajuda"
strCorpo = strCorpo & "
objmail.To = Me!Email_P 'destinatário
objmail.CC = Me!Email_S 'com cópia
'objmail.BCC = Nz(Me!TxCco, "") 'Com cópia oculta
objmail.Subject = strAssunto
objmail.HTMLbody = strCorpo
'--------------------------------------------------------
'Mostra o formulário de envio de email
'--------------------------------------------------------
objmail.Display 'para enviar direto, altere esta linha para objmail.send
'-------------------------------------------
'Deleta Fatura criado na pasta Enviados
'------------------------------------------
FileSystem.Kill (strLocal)
'-------------------------------------------------------
'Tudo já foi entregue ao Outlook; então podemos esvaziar
'a memória do computador usada pelas variáveis objeto.
'-------------------------------------------------------
Set objAnexo = Nothing
Set objmail = Nothing
Set objOut = Nothing
End Sub
Estou com problema para enviar email em num de meus formulários, acredito que foi depois que mudei para Windows 64 bits. Agradeço o suporte
Links - Tela erro
mega.nz/#!wmYjhJba!4X-uAfcO04MIUIdKWKGZVhWHkfaeClyW0VX5R72_Q5g
mega.nz/#!5zZQRR7A!xQuA-OA0IAjfCSPglo6RwEe6z5_qjTg2TRHH0dLyy6E
Private Sub btEnviarProposta_Click()
Dim strArquivo As String
Dim strLocal As String
Dim objOut As Object
Dim objmail As Object
Dim objAnexo As Object
Const olMailItem = 0
Const olByValue = 1
'-----------------------------------------------------------------------------
'verifica se existe endereço de email. Caso não exista. aborda procedimento.
'-----------------------------------------------------------------------------
If IsNull(Me!Email_P) Then
MsgBox "Está faltando o endereço de email Principal...", vbInformation, "Aviso"
Exit Sub
End If
If IsNull(Me!Email_S) Then
MsgBox "Está faltando o endereço de email Secundario...", vbInformation, "Aviso"
Exit Sub
End If
Set objOut = CreateObject("Outlook.application")
Set objmail = objOut.CreateItem(olMailItem)
Set objAnexo = objmail.Attachments
strArquivo = "FATURA - " & Me!FATURA & " - " & Me!DescriçãoGeral & ".pdf"
strLocal = CurrentProject.Path & "\.\" & strArquivo
If Me.Dirty Then DoCmd.RunCommand acCmdSaveRecord
DoCmd.OpenReport "fatura_com", acViewPreview, , "Fatura = " & Me!FATURA, acHidden
DoCmd.OutputTo acOutputReport, "fatura_com", acFormatPDF, strLocal
DoCmd.Close acReport, "fatura_com"
objAnexo.Add strLocal, olByValue, 1
strAssunto = "COBRANÇA HT LOGÍSTICA - Fatura Referente a " & StrConv(Format(Me!DescriçãoGeral), vbProperCase) & "."
strCorpo = StrConv(Format(Me!Saudacao), vbProperCase) & "
Prezado(a)s!
Segue anexo a fatura: " & StrConv(Format(Me!FATURA), vbProperCase) & ", referente a intermediação de serviços postais " & StrConv(Format(Me!DescriçãoGeral), vbProperCase)
strCorpo = strCorpo & ", com vencimento para " & Me!DT_VENCIMENTO & " no valor total de R$ " & (Format(Me!Total)) & ".
"
strCorpo = strCorpo & "Ficamos à disposição para quaisquer esclarecimentos, podendo atendê-lo a com a devida presteza.
*Favor confirmar o recebimento." & "
"
strCorpo = strCorpo & "AVISO:
Gentileza verificar as atualizações de prazo e informativos no portal dos CORREIOS
1.http://correios.com.br/para-voce/avisos
2.http://correios.com.br/para-voce/precisa-de-ajuda"
strCorpo = strCorpo & "
objmail.To = Me!Email_P 'destinatário
objmail.CC = Me!Email_S 'com cópia
'objmail.BCC = Nz(Me!TxCco, "") 'Com cópia oculta
objmail.Subject = strAssunto
objmail.HTMLbody = strCorpo
'--------------------------------------------------------
'Mostra o formulário de envio de email
'--------------------------------------------------------
objmail.Display 'para enviar direto, altere esta linha para objmail.send
'-------------------------------------------
'Deleta Fatura criado na pasta Enviados
'------------------------------------------
FileSystem.Kill (strLocal)
'-------------------------------------------------------
'Tudo já foi entregue ao Outlook; então podemos esvaziar
'a memória do computador usada pelas variáveis objeto.
'-------------------------------------------------------
Set objAnexo = Nothing
Set objmail = Nothing
Set objOut = Nothing
End Sub