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:
Thanks in advance!
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 SubThanks in advance!
