Bom dia amigos!
Novamente preciso muito da ajuda de vocês!
Tenho um programa que gera orçamentos e é utilizado por alguns usuários com o Runtime 2013. Somente em um único usuário (justamente o que mais necessita do programa), um a cada 4 orçamentos que são gerados (em média) da erro e o programa fecha sem nem passar pelo tratamento de erro. Ele simplesmente fecha.
Como já coloquei um msgbox a cada linha para identificar onde o erro ocorre sei que é sempre na linha do "DoCmd.OutputTo acOutputReport, "rpDetalheOrçamento", acFormatPDF, strCaminho, False"
O código é o seguinte:
Muito obrigado pela atenção!
Novamente preciso muito da ajuda de vocês!
Tenho um programa que gera orçamentos e é utilizado por alguns usuários com o Runtime 2013. Somente em um único usuário (justamente o que mais necessita do programa), um a cada 4 orçamentos que são gerados (em média) da erro e o programa fecha sem nem passar pelo tratamento de erro. Ele simplesmente fecha.
Como já coloquei um msgbox a cada linha para identificar onde o erro ocorre sei que é sempre na linha do "DoCmd.OutputTo acOutputReport, "rpDetalheOrçamento", acFormatPDF, strCaminho, False"
O código é o seguinte:
- Código:
Public Function EnviarEmail(Orc As String)
On Error GoTo final
Dim HTM, ASS As String
Dim appOutlook As Object
Dim MailOutLook As Object
Dim strRecipient As String
Dim strHeader As String
Dim strBody As String
Dim strArquivo As String
Dim strLocal As String
Dim strCaminho As String
Dim objOut As Object
Dim objmail As Object
Dim objAnexo As Object
Const olMailItem = 0
Const olByValue = 1
Set objOut = CreateObject("Outlook.application")
Set objmail = objOut.CreateItem(olMailItem)
Set objAnexo = objmail.Attachments
strArquivo = "Orçamento " & Orc & ".pdf"
strLocal = "C:\Users\Regiane\Documents\Orcamentos\"
strCaminho = strLocal & strArquivo
DoCmd.OutputTo acOutputReport, "rpDetalheOrçamento", acFormatPDF, strCaminho, False
objAnexo.Add strLocal & strArquivo, olByValue, 1
Set appOutlook = CreateObject("Outlook.Application")
Set MailOutLook = appOutlook.CreateItem(olMailItem)
strHeader = "Orcamento nº" & Orc
strBody = "Segue em anexo o Orçamento Solicitado"
HTM = "<html><body style='font-family:calibri'><font size = '3'>" & _
"<p>Bom dia, </p>" & _
"<p>Segue em anexo o orçamento para sua aprovação. </p>" & _
"<p>Essa é uma mensagem automática. </p>" & _
"<p>Lembre-se de verificar se as medidas, valores, impostos, transportadora e prazo, </p>" & _
"<p>só aceitamos devolução de mercadoria em caso de defeito de fabricação. </p>" & _
"<p> Atenciosamente, </p>" & _
"<p><b><font color ='#000080'> Equipe Abrasipa </b></p>" & _
"<p><font color ='#000080' size ='-1' face='calibri'>Tel.: 11 3933-2994 Ramal 103 Whatsapp 11 99447-2373</p> "
ASS = "<BODY BGCOLOR='#ffffff'>" & _
"<FONT COLOR='#000080' SIZE='-1' FACE='Arial'><HR ALIGN=LEFT></FONT><FONT " & _
"SIZE='-1' FACE='Arial'><A HREF='http://www.abrasipa.com.br/'><MAP' " & _
"NAME='assinatura_brMap5'> " & _
"<AREA SHAPE='rect' COORDS='0,0,250,40' HREF='http://www.abrasipa.com.br/'> " & _
"</MAP><IMG SRC='http://www.abrasipa.com.br/abrasipa2016/wp-content/uploads/2016/06/assinatura_br.jpg' " & _
"ALIGN='BOTTOM' BORDER='0' USEMAP='#assinatura_brMap5' ISMAP WIDTH='250' " & _
"HEIGHT='40' NATURALSIZEFLAG='3'></A></FONT><!--SELECTION--><!--/SELECTION--><BR> " & _
"<FONT SIZE='-1' FACE='Arial'><A HREF='http://www.abrasipa.com.br/'><IMG " & _
"SRC = 'http://www.abrasipa.com.br/abrasipa2016/wp-content/uploads/2016/06/iso_9001_18mm.jpg' " & _
"ALIGN='BOTTOM' BORDER='0' WIDTH='106' HEIGHT='93' NATURALSIZEFLAG='3'></A></FONT><BR> " & _
"<BR> " & _
"<B><I><FONT COLOR='#000080' SIZE='-1' FACE='Arial'>Follow Us </FONT><FONT " & _
"SIZE='-1' FACE='Arial'><A HREF='http://www.facebook.com/Abrasipa'><IMG " & _
"SRC='http://www.abrasipa.com.br/abrasipa2016/wp-content/uploads/2016/06/fbk.jpg' ALIGN='TOP' " & _
"BORDER='0' WIDTH='22' HEIGHT='22' NATURALSIZEFLAG='3'></A></FONT><FONT " & _
"COLOR='#000080' SIZE='-1' FACE='Arial'> </FONT><FONT COLOR='#ffffff' " & _
"SIZE='-1' FACE='Arial'>.</FONT><FONT SIZE='-1' FACE='Arial'><A " & _
"HREF='http://www.twitter.com/abrasipa'><IMG SRC='http://www.abrasipa.com.br/abrasipa2016/wp-content/uploads/2016/06/twit.jpg' " & _
"ALIGN='TOP' BORDER='0' WIDTH='22' HEIGHT='22' NATURALSIZEFLAG='3'></A></FONT></I></B> " & _
"</font></body></html> "
With MailOutLook
.To = strRecipient
.Subject = strHeader
.HTMLBody = HTM & ASS
.Attachments.Add (strLocal & strArquivo)
.Send
End With
Set objOut = Nothing
Set objmail = Nothing
Set objAnexo = Nothing
Set appOutlook = Nothing
Set MailOutLook = Nothing
strArquivo = ""
strLocal = ""
strCaminho = ""
DoCmd.Close acReport, "rpDetalheOrçamento", acSaveNo
Exit Function
final:
MsgBox Err.Number & " " & Err.Description
End Function
Muito obrigado pela atenção!