Excel VBA - Salvar em pdf como nome especifico e enviar por e-mail

[feitotc]

Boa noite!

Pessoal preciso criar uma macro na qual seja selecionada a plan 1, criasse um PDF com nome especifico de uma célula e esta mesma salve em uma pasta especifica e envie por e-mail usei a formula a seguir com as adaptações devidas para o meu caso porém estou tendo um dificuldade em relação a anexar o PDF salvo e também a selecionar a plan 1 se alguém tiver alguma ideia ficarei grato.

Há esqueci de mencionar o problema que encontro e que se já existe o arquivo ele encontra e envia normalmente mas quando gero um novo ele da erro no myAttachments.Add FileName. E na plan 1 ele só salva o que for selecionado gostaria que fosse toda a plan 1.

segue código usado e modelo da planilha.

http://www.sendspace.com/file/c1y8h6

Sub ImprimirComoPDF_e_EnviarViaOutlook()

Dim myobject As New Bullzip.PDFPrinterSettings

Dim SavePath As String, FileName As String

Dim myOlApp, myItem, myAttachments

Dim endereco As String

endereco = "[email protected];[email protected]" & ";" & " " & Sheets("PRINCIPAL").Range("W6").Value

'-----------------------------------------------------------------------------------------------------------

'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\Dienifer\Desktop\TESTE PDF\" & Range("C5").Value & " " & Range("Y1").Value & ".pdf"

With myobject

.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 = endereco

.Subject = "Pedido" & " " & Range("C5").Value & Range("Y1").Value

.Body = "Segue anexo pedido" & " " & Range("C5").Value & Range("Y1").Value

.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

[feitotc]

Boa noite a todos os membros e visitantes.

segue formula VBA para Salvar em PDF e enviar e-mail com anexo.

Sub salvar_enviar_PDF()

'SALVA O ARQUIVO EM PDF NA PASTA ESCOLHIDA COM O NOME ESCOLHIDO DE UMA CELULA OU MAIS

Dim nome As String

Dim endereco As String

'SÃO OS DESTINATARIOS DE EMAIL MAIS O NOME DO ARQUIVO MAIS O NUMERO DO PEDIDO NO MEU CASO

endereco = "[email protected];[email protected]" & ";" & " " & Sheets("nome da plan").Range("numero da celula").Value

'E O LOCAL ONDE SALVA O ARQUIVO MAIS O NOME DO ARQUIVO E O NUMERO DO PEDIDO

nome = "C:\Users\Dienifer\Desktop\teste\" & Range("numero da célula pode ser o nome do cliente").Value & "-" & Range("numero da célula pode ser o numero do pedido").Value & ".pdf"

'SAO AS SELECIONADAS QUE APARECERAM NO PDF

ActiveSheet.Range("a1:aa48 no caso são as células que devem aparecer no pdf").ExportAsFixedFormat Type:=xlTypePDF, Filename:=nome

'ENVIA O ARQUIVO SALVO PARA OS ENDEREÇOS QUE voce ESCOLHER MAIS O ENDEREÇO DE UMA CELULA NO MEU CASO

Set myActiveSheet = CreateObject("Outlook.Application")

Set objMail = myActiveSheet.CreateItem(olMailItem)

Set myAttachments = objMail.Attachments

With objMail

.To = endereco

.Subject = "Segue Anexo Pedido" & " " & Range("numero da célula, no caso nome do cliente").Value & " " & Range("numero da célula, no caso numero do pedido").Value

.HTMLBody = "discrição do que você quer que apareça no corpo do e-mail."

myAttachments.Add nome

.Display

End With

End Sub

[Patropi]

Caso o autor necessite, o mesmo será reaberto, para isso deverá entrar em contato com a moderação solicitando o desbloqueio.