Sub ENVIAR_PEDIDO_FÁBRICA_MERVER()
Dim myobject As New Bullzip.PDFPrinterSettings
Dim SavePath As String, FileName As String
Dim myOlApp, myItem, myAttachments
'-----------------------------------------------------------------------------------------------------------
'1ª parte do código: salvar um arquivo PDF com o mesmo nome e no mesmo diretório do arquivo excel original
'contendo a área selecionada de uma planilha
'-----------------------------------------------------------------------------------------------------------
FileName = "C:\Users\Pablo\Desktop\do trabalho Pablo\todas as tabelas\MERVER\PEDIDOS MERVER\PEDIDO " & "MERVER" & " " & ActiveSheet.Range("AB1").Value & " (" & ActiveSheet.Range("b4").Value & ")" & ".pdf"
With myobject -----------
(aqui o depurador indica o problema)
.SetValue "output", SavePath & FileName
.SetValue "showsettings", "never"
.WriteSettings (True)
End With
'Modificando a impressora para Bullzip...
If InStr(ActivePrinter, "Bullzip") = 0 Then
Dim storeprinter$, PrinterChanged As Boolean
PrinterChanged = True
storeprinter = ActivePrinter
ActivePrinter = GetFullNetworkPrinterName("Bullzip")
End If
Selection.PrintOut
Caixa = MsgBox("Confirme se o arquivo PDF foi salvo antes de prosseguir.", vbYesNo + vbQuestion, "Exportação PDF")
If Caixa = vbNo Then Exit Sub
If PrinterChanged Then ActivePrinter = storeprinter
'-----------------------------------------------------------------------------------------------------------
'2ª parte do código: enviar o arquivo PDF criado na etapa anterior via e-mail como um anexo de mensagem
'-----------------------------------------------------------------------------------------------------------
Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.CreateItem(olMailItem)
Set myAttachments = myItem.Attachments
With myItem
.To = "
vendas@merver.com.br"
.Subject = "PEDIDO MERVER" & " " & Range("AB1") & "-" & "PABLO VALANDRO"
.Body = "OLÁ!!!" & vbNewLine & _
" " & vbNewLine & _
"SEGUE EM ANEXO PEDIDO MERVER" & " " & Range("AB1") & "." & vbNewLine & _
" " & vbNewLine & _
"ACUSAR RECEBIMENTO" & vbNewLine & _
" " & vbNewLine & _
"Atc" & vbNewLine & _
"Pablo Valandro" & vbNewLine & _
"Representante Comercial" & vbNewLine & _
"cel. 51 993504711 wats" & vbNewLine & _
"
pvalandro@hotmail.com" & vbNewLine & _
.Save
myAttachments.Add FileName
.Display
End With
End Sub
Function GetFullNetworkPrinterName(strNetworkPrinterName As String) As String
'-----------------------------------------------------------------------------------------------------------
'Função para estabelecer Bullzip como impressora de destino para o PDF gerado
'-----------------------------------------------------------------------------------------------------------
' Retorna o nome completo da impressora da rede
' retorna um texto vazio se não for encontra da impressora
' i.e. GetFullNetworkPrinterName("HP LaserJet 8100 Series PCL")
' deve retornar "HP LaserJet 8100 Series PCL em Ne04:"
Dim strCurrentPrinterName As String, strTempPrinterName As String, i As Long
strCurrentPrinterName = Application.ActivePrinter
i = 0
Do While i < 100
strTempPrinterName = strNetworkPrinterName & " PDF Printer em Ne" & Format(i, "00") & ":"
On Error Resume Next
'Tentativa de estabelecer Bullzip como impressora ativa
Application.ActivePrinter = strTempPrinterName
On Error GoTo 0
If Application.ActivePrinter = strTempPrinterName Then
'Bullzip foi localizada
GetFullNetworkPrinterName = strTempPrinterName
i = 100 'atribuição para concluir o loop
End If
i = i + 1
Loop
'retorna para a impressora ativa original
Application.ActivePrinter = strCurrentPrinterName
End Function
Sub Envia_Emails(EnviarPara As String, Mensagem As String)
Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.To = EnviarPara
.CC = ""
.BCC = ""
.Subject = "Pedido enviado"
.Body = Mensagem
.Display ' para envia o email diretamente defina o código .display
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub