VBA to save file in excel and Pdf format to specific folder

[Jnb99]

Good day,



I did this VBA a few years ago (searched online and YouTube), and had the save as function as well. It worked like a machine, but somehow I either deleted the Workbook or something else went wrong. I've never used it again until recently, mostly because i didn't need it.



I would like to save a copy of the file in Pdf and excel format to a specific folder, keep the email function, and then clear the sheet. If the sheet is cleared, It must also automatically count up the next document number.

The code below:

Sub PostToRegister()

Dim WS1 As Worksheet

Dim WS2 As Worksheet

Set WS1 = Worksheets("Quotation")

Set WS2 = Worksheets("Register")

' Figure out which row is next row

NextRow = WS2.Cells(Rows.Count, 1).End(xlUp).Row + 1

'Write the important values to register

WS2.Cells(NextRow, 1).Resize(1, 5).Value = Array(WS1.Range("J1"), WS1.Range("J3"), WS1.Range("C9"), WS1.Range("C10"), Range("QteTot"))



End Sub





Sub InsertRow()

    Dim Rng, n As Long, k As Long

    Application.ScreenUpdating = False

    Rng = InputBox("Enter number of rows required.")

    If Rng = "" Then Exit Sub

    Range(ActiveCell, ActiveCell.Offset(Val(Rng) - 1, 0)).EntireRow.Insert

    'need To know how many formulas To copy down.

    'Assumesfrom A over To last entry In row.

    k = ActiveCell.Offset(-1, 0).Row

    n = Cells(k, 256).End(xlToLeft).Column

    Range(Cells(k, 1), Cells(k + Val(Rng), n)).FillDown

End Sub



Sub AttachActiveSheetPDF()

  Dim IsCreated As Boolean

  Dim i As Long

  Dim PdfFile As String, Title As String

  Dim OutlApp As Object

 

  ' Not sure for what the Title is

  Title = Range("C10")

 

  ' Define PDF filename

  PdfFile = ActiveWorkbook.FullName

  i = InStrRev(PdfFile, ".")

  If i > 1 Then PdfFile = Left(PdfFile, i - 1)

  PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"

 

  ' Export activesheet as PDF

  With ActiveSheet

    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

  End With

 

  ' Use already open Outlook if possible

  On Error Resume Next

  Set OutlApp = GetObject(, "Outlook.Application")

  If Err Then

    Set OutlApp = CreateObject("Outlook.Application")

    IsCreated = True

  End If

  OutlApp.Visible = True

  On Error GoTo 0

 

  ' Prepare e-mail with PDF attachment

  With OutlApp.CreateItem(0)

   

    ' Prepare e-mail

    .Subject = Title

    .To = "admin@xxxxxxx" ' <-- Put email of the recipient here

    .CC = "neil@xxxxxxxxxx" ' <-- Put email of 'copy to' recipient here

    .Body = "Hi," & vbLf & vbLf _

          & "The quote is attached in PDF format." & vbLf & vbLf _

          & "Regards," & vbLf _

          & "C2C Quotes" & vbLf & vbLf

    .Attachments.Add PdfFile

   

    ' Try to send

    On Error Resume Next

    .Send

    Application.Visible = True

    If Err Then

      MsgBox "E-mail was not sent", vbExclamation

    Else

      MsgBox "E-mail successfully sent", vbInformation

    End If

    On Error GoTo 0

   

  End With

 

  ' Delete PDF file

  Kill PdfFile

 

  ' Quit Outlook if it was created by this code

  If IsCreated Then OutlApp.Quit

 

  ' Release the memory of object variable

  Set OutlApp = Nothing

 

End Sub

Thanks in advance!

 

[Jnb99]

Hi @Sunjinsak,

Hope you had a good weekend!

I Changed some om your code because it ran some errors, but now it's giving me other problems.
If the Value in K2 is not cleared, the

'Increment document number
    ActiveSheet.Range("K2").Value = ActiveSheet.Range("K2").Value + 1

section run an error. If I clear the contents of K2, it compile without an error, save the name correct but on the document itself Cell K2 which is the document number is obviously blank still. Is there a way around this?

 

[Sunjinsak]

Hello again. Sorry for the late reply!

I Changed some om your code because it ran some errors, but now it's giving me other problems.
If the Value in K2 is not cleared, the

'Increment document number
    ActiveSheet.Range("K2").Value = ActiveSheet.Range("K2").Value + 1

section run an error. If I clear the contents of K2, it compile without an error, save the name correct but on the document itself Cell K2 which is the document number is obviously blank still. Is there a way around this?

How is cell K2 formatted? It needs to be formatted as a number, not as text. I'm guessing that might have something to do with the error, though without the actual error message I can't be sure. If changing the cell formatting doesn't work post the actual error message and I should be able to help.

"5. Clear body of quote when saved (if possible) "
I don't this this will be possible, because all quotes wont be the same amount of rows, so is there a way to have it recognize the quote body?

Is the quote body a fixed range, regardless of how many rows are occupied within that range? If so you can just clear the whole range with something like the following (though obviously you'd want to change the range to your needs)...

Sheets("Quotation").Range("A18:L35").ClearContents

If there are multiple non-contiguous ranges you can just add extra lines for each of the required ranges.