pdf name aotomatic????? macro vba code?

[albertc30]

Hello everybody.

I have the code bellow to print my invoice to pdf format to have a digital copy of it.

The code uses the sheet name to name the file.

Now how can I make this also add the invoice number to the Invoice to save in pdf?

Any help is a blessing.

Cheers.

Albert

Option Explicit

Sub PrintSheetAsPDF()
    PrintSheet
End Sub

Sub PrintSheet(Optional sFileName As String = "", Optional confirmOverwrite As Boolean = True)
    Dim oPrinterSettings As Object
    Dim oPrinterUtil As Object
    Dim sFolder As String
    Dim sCurrentPrinter As String
    Dim xmldom As Object
    Dim sProgId As String
    Dim sPrintername As String
    Dim sFullPrinterName As String
    
    Rem -- Documentation of the used COM interface is available at the link below.
    Rem -- http://www.biopdf.com/guide/dotnet/chm/html/T_bioPDF_PdfWriter_PdfSettings.htm
    
    Rem -- Create the objects to control the printer settings.
    Rem -- Replace biopdf with bullzip if you have the bullzip printer installed instead
    Rem -- of the biopdf printer.
    Set oPrinterSettings = CreateObject("biopdf.PdfSettings")
    Set oPrinterUtil = CreateObject("biopdf.PdfUtil")
    
    Rem -- Get default printer name
    sPrintername = oPrinterUtil.DefaultPrintername
    oPrinterSettings.Printername = sPrintername
    
    Rem -- Get the full name of the printer
    sFullPrinterName = FindPrinter(sPrintername)
    sFullPrinterName = GetFullNetworkPrinterName(sFullPrinterName)
        
    Rem -- Prompt the user for a file name
    sFolder = Environ("USERPROFILE") & "\Desktop\"
    If sFileName = "" Then
        sFileName = InputBox("Save PDF to desktop as:", "Sheet '" & _
            ActiveSheet.Name & "' to PDF...", ActiveSheet.Name)
                
        Rem -- Abort the process if the user cancels the dialog
        If sFileName = "" Then Exit Sub
        
        sFileName = sFolder & sFileName
    End If
        
    Rem -- Make sure that the file name ends with .pdf
    If LCase(Right(sFileName, 4)) <> ".pdf" Then
        sFileName = sFileName & ".pdf"
    End If
    
    Rem -- Write the settings to the printer
    Rem -- Settings are written to the runonce.ini
    Rem -- This file is deleted immediately after being used.
    With oPrinterSettings
        .SetValue "Output", sFileName
        If confirmOverwrite Then
            .SetValue "ConfirmOverwrite", "yes"
        Else
            .SetValue "ConfirmOverwrite", "no"
        End If
        .SetValue "ShowSettings", "never"
        .SetValue "ShowPDF", "yes"
        .WriteSettings True
    End With
    
    Rem -- Change to PDF printer
    sCurrentPrinter = ActivePrinter
    ActivePrinter = sFullPrinterName
    
    Rem -- Print the active work sheet
    ActiveSheet.PrintOut
    
    Rem -- Restore the printer selection
    ActivePrinter = sCurrentPrinter
End Sub

Function GetFullNetworkPrinterName(NetworkPrinterName As String) As String
    Rem -- Returns the full network printer name
    Rem -- Returns an empty string if the printer is not found
    Rem -- E.g. GetFullNetworkPrinterName("HP LaserJet 8100 Series PCL")
    Rem -- Might return "BIOPDF on Ne04:"
    Dim sCurrentPrinterName As String
    Dim sTempPrinterName As String
    Dim i As Long
    
    sCurrentPrinterName = Application.ActivePrinter
    i = 0
    Do While i < 100
        sTempPrinterName = NetworkPrinterName & " on Ne" & Format(i, "00") & ":"
        On Error Resume Next
        Rem -- Try to change to the network printer
        Application.ActivePrinter = sTempPrinterName
        On Error GoTo 0
        If Application.ActivePrinter = sTempPrinterName Then
            Rem -- The network printer was found
            GetFullNetworkPrinterName = sTempPrinterName
            Exit Do
        End If
        i = i + 1
    Loop
    Application.ActivePrinter = sCurrentPrinterName
End Function

Function FindPrinter(sPrinterNameFragment As String) As String
    Rem -- Find the full printer name base on a fragment of the name
    Rem -- Use the GetFullNetworkPrinterName function to get the NeXX
    Rem -- part of the name.
    Dim wsh As Object
    Dim oPrinterCollection
    Dim i As Integer
    
    Set wsh = CreateObject("WScript.Network.1")
    Set oPrinterCollection = wsh.EnumPrinterConnections
    For i = 1 To oPrinterCollection.Count - 1 Step 2
        If InStr(1, LCase(oPrinterCollection(i)), LCase(sPrinterNameFragment)) > 0 Then
            FindPrinter = oPrinterCollection(i)
            Exit Function
        End If
    Next
End Function

 

[Andrew Poulsom]

If the invoice number is in A1 try:

sFileName = sFolder & sFileName & Range("A1").Value

 

[albertc30]

If the invoice number is in A1 try:

sFileName = sFolder & sFileName & Range("A1").Value

I mate.

It did not worked. I believe that bellow is the line where to have this changed.

Also I have tried to change location where to save files but again without success.

Help please.

Rem -- Prompt the user for a file name
    sFolder = "J:\InvoicePDF"
    If sFileName = "" Then
        sFileName = InputBox("Save PDF as:", "Sheet '" & _
            ActiveSheet.Name & Range("A1").Value"' to PDF...", ActiveSheet.Name)
                
        Rem -- Abort the process if the user cancels the dialog
        If sFileName = "" Then Exit Sub
        
        sFileName = sFolder & sFileName

 

[Andrew Poulsom]

In what way didn't it work?

 

[albertc30]

In what way didn't it work?

Sorry, but the result was still the same. Only Invoice showed up on the save box.

 

[albertc30]

I would like to do the following changes to the code to allow the following;

1 - Automatacly print file (.PDF) with InvoiceNumber as Invoice is the sheet name and Number is taken from a field where the number is.

2 - If invoice already saved then msg Invoice already saved with OK button.

3 - Also I would like to change the path to another path like c:/InvoicesFolder.

Any help much appreciated.

Thanks

Albert

 

[Andrew Poulsom]

My code assumed that the invoice number was in A1 on the active sheet. Adjust the range reference to suit.

 

[albertc30]

My code assumed that the invoice number was in A1 on the active sheet. Adjust the range reference to suit.

Again apologies if I was misleading but I do have data on cell A1. However the changes in the macro did not extracted this data.

I have played with the code bellow. Have changed the sheet name which had a direct impact on the file name. This is why I am assuming the code for naming should be there but please, I am no programmer nor understand VBA.

sFileName = InputBox("Save PDF as:", "Sheet '" & _
ActiveSheet.Name & Range("A1").Value"' to PDF...", ActiveSheet.Name)

Any help anybody?

Cheers.
Albert

 

[Andrew Poulsom]

Did you change:

sFileName = sFolder & sFileName

to?

sFileName = sFolder & sFileName & Range("A1").Value