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

Jnb99

New Member
Joined
Mar 29, 2016
Messages
46
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:



VBA Code:
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

New Member
Joined
Mar 29, 2016
Messages
46
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
VBA Code:
'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?
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.

Sunjinsak

Board Regular
Joined
Jul 13, 2011
Messages
143
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2013
Platform
  1. Windows
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
VBA Code:
'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)...
VBA Code:
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.
 
Learn Excel from Bill Jelen

Understanding data is crucial, and the easiest place to start is with Microsoft Excel.

Forum statistics

Threads
1,151,589
Messages
5,765,320
Members
425,273
Latest member
tonio909

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top