Invoicing VBA Solution - Please Help

[Tenacious1]

Hi there

There are 16 properties made up of 54 tenants. We arrange the insurance and pay a rounded premium for the entire portfolio.

The total premium has been apportioned per property already by the insurance company, and I have now apportioned the premium per tenant per property within the 'Data'.

I am a beginner with VBA but what I would like to do is hit a button and create an invoice for each tenant (in PDF) based on the premium data entered in excel, and to save it to a folder.

I understand very basic VBA so I am not coming in completely blind.

The layout of the headers in the data based on the information required for an invoice is as follows (in order from top of the invoice to bottom)

Columns:

Tenants name: F
Address: C
Premium: U


Any help would be greatly appreciated. Thanks

 

[Yongle]

On way
- creates PDFs named in this manner Insurance 18-07-28 Peter Smith.pdf and saves them to a common folder

To test method
- add a worksheet sheet
- name it "Invoice"
- create your blank invoice on that sheet

Place VBA below sheet module of the sheet containing your data (right click on that sheet tab \ view code \ paste in window on right)
- Replace B1,B2,B3 with the correct cells for your invoice
(B1 is tenant name, B2 is address, B3 is amount)
- Replace A1:D10 with range to save to PDF
(needs to contain all cells in your invoice area)
- replace path where PDF's should be saved

Sub InvoiceTenant()

Const fPath = "[COLOR=#ff0000]C:\Folder\Sub-Folder[/COLOR]"
Dim rng As Range, Tenant As Range, Addr As Variant, adj As String, fName As String
Set rng = Range("F2", Range("F" & Rows.Count).End(xlUp))
adj = Format(Date, " yy-mm-dd ")
Sheets("Invoice").Activate
    For Each Tenant In rng       
        With ActiveSheet
            .Range("[B]B1[/B]").Value = Tenant
            .Range("[B]B2[/B]").Value = Tenant.Offset(, -3)
            .Range("[B]B3[/B]").Value = Tenant.Offset(, 15)
            fName = fPath & "\" & "Insurance " & adj & Tenant
            .Range("[B]A1:D10[/B]").ExportAsFixedFormat Type:=xlTypePDF, Filename:=fName
        End With
    Next
End Sub

 

[Tenacious1]

This is fantastic, it worked to the letter.

If I want to add more information to the invoice from the data can I simply replicate the formatting on from '.Range("B3").value = TenantOffset?

As this works so well, would there be a way to add something on the end to email the saved pdf invoices to respective email addresses via outlook?

Many thanks for this. It has saved me a huge amount of time!

 

[Tenacious1]

Sorry just to expand on my question above, if I wanted to also include another tab, lets say for the insurance certificate, do I just need to adjust the code from 'Sheets("Invoice").Active and reflect the name of the new worksheet.

Thanks

 

[Yongle]

Adding email

This is a bit of a stab in the dark - I cannot test - I do not use Outlook

- original VBA amended see blue
- tenant.Offset(, 20) assumes email addresses are in column Z
- private sub SendEmail added
- paste private sub into same module as InvoiceTenant

Sub InvoiceTenant()

Const fPath = "C:\Folder\Sub_Folder"
Dim rng As Range, tenant As Range, Addr As Variant, adj As String, fName As String[COLOR=#0000cd], eAddr As String[/COLOR]
Set rng = Range("F2", Range("F" & Rows.Count).End(xlUp))
adj = Format(Date, " yy-mm-dd ")
Sheets("Invoice").Activate
    For Each tenant In rng
        With ActiveSheet
            .Range("B1").Value = tenant
            .Range("B2").Value = tenant.Offset(, -3)
            .Range("B3").Value = tenant.Offset(, 15)
            fName = fPath & "\" & "Insurance " & adj & tenant
            .Range("A1:D10").ExportAsFixedFormat Type:=xlTypePDF, Filename:=fName
           [COLOR=#000080] eAddr = tenant.Offset(, 20)[/COLOR]
            [COLOR=#0000cd]Call SendEmail(tenant.Value, eAddr, fName)[/COLOR]
        End With
    Next
End Sub

Private Sub SendEmail(tenant As String, eAddr As String, fName As String)
[COLOR=#ff0000]'Remember to add reference to [I]Microsoft Outlook Object library[/I] (under VBA \ Tools \ References)[/COLOR]
    Dim obMail As Outlook.MailItem
    Dim Greeting, WrdStr As String, EndStr As String, BodyTxt As String, Subj As String
'build strings
    Subj = "Insurance Premium Allocation"
    Greeting = "Dear " & tenant
    WrdStr = "Attached is invoice for your insurance...etc"
    EndStr = "Yours sincerely" & vbCr & "Yongle"
    BodyTxt = Greeting & vbCr & WrdStr & vbCr & EndStr
'send emails
    Set obMail = Outlook.CreateItem(olMailItem)
        With obMail
            .To = eAddr
            .Subject = Subj
            .BodyFormat = olFormatPlain
            .Body = BodyTxt
            .Attachments.Add (fName)
            .Send
        End With

End Sub

 

[Yongle]

if I wanted to also include another tab, lets say for the insurance certificate, do I just need to adjust the code from 'Sheets("Invoice").Active and reflect the name of the new worksheet.

again this is a stab in the dark (and assumes previous VBA worked)

Save a copy of the Insurance Certificate as a PDF to the same folder and...

Add this line (after correcting the full path to file)

.Attachments.Add ("[COLOR=#ff0000]C:\Folder\SubFolder\InsuranceCert.PDF[/COLOR]")

Below this line

.Attachments.Add (fName)

 

[Tenacious1]

Thanks for this.

I have only just had a chance to test this.

I added Outlook in references, but the following error returns when executing the code:

'Compile Error'
ByRef argument type mismatch

With the following highlighted in the code itself

'eAddr'

 

[Yongle]

To amend
Something I have spotted which is nothing to do with your compile error..
Please amend as follows:
One line to be amended - I forgot to add the file extension to the filename - so VBA would never find it!
and one line to be inserted

    BodyTxt = Greeting & vbCr & WrdStr & vbCr & EndStr
    fName = fName[COLOR=#ff0000] & ".pdf"[/COLOR]
    [COLOR=#000080]On Error Resume Next[/COLOR]
    Set obMail = Outlook.CreateItem(olMailItem)

Outlook status
Keep Outlook open when you are running the code

Compile error
I do not understand why it does not compile for you - it does for me.
Q In precisely which line is eAddr highlighted?
- it appears 5 times in the code

 

[Tenacious1]

Amendment noted thanks.

It is in the last line of the invoice tenant code before End With - see below in bold.

.Range("B2:F44").ExportAsFixedFormat Type:=xlTypePDF, Filename:=fName
eAddr = tenant.Offset(, 20)
Call SendEmail(tenant.Value, eAddr, fName)
End With

 

[Yongle]

Try this then
- a bit belt & braces
- amend column offset to match where your email addresses are placed (code currently looking in Z)

Sub InvoiceTenant()
Const fPath = "C:\Folder\Sub Folder"
Dim rng As Range, tenant As Range, Addr As Variant, adj As String, fName As String, eAddr As String
Set rng = Range("F2", Range("F" & Rows.Count).End(xlUp))
adj = Format(Date, " yy-mm-dd ")
Sheets("Invoice").Activate
    For Each tenant In rng
        With ActiveSheet
            .Range("B1").Value = tenant
            .Range("B2").Value = tenant.Offset(, -3)
            .Range("B3").Value = tenant.Offset(, 15)
            fName = fPath & "\" & "Insurance " & adj & tenant
            .Range("A1:D10").ExportAsFixedFormat Type:=xlTypePDF, Filename:=fName
            eAddr = [COLOR=#ff0000]CStr(tenant.Offset(, 20).Value)[/COLOR]
           [COLOR=#ff0000] If InStr(1, eAddr, "@") > 0 Then Call SendEmail(tenant.Value, eAddr, fName)[/COLOR]
        End With
    Next
End Sub

Private Sub SendEmail([COLOR=#ff0000]ByVal [/COLOR]tenant As String, eAddr As String, fName As String)
'Remember to add reference Microsoft Outlook Object library (under VBA \ Tools \ References
    Dim obMail As Outlook.MailItem
    Dim Greeting, WrdStr As String, EndStr As String, BodyTxt As String, Subj As String
    Subj = "Insurance Premium Allocation"
    Greeting = "Dear " & tenant
    WrdStr = "Attached is invoice for your insurance...etc"
    EndStr = "Yours sincerely" & vbCr & "Yongle"
    BodyTxt = Greeting & vbCr & WrdStr & vbCr & EndStr
    fName = fName & ".pdf"
    On Error Resume Next
    Set obMail = Outlook.CreateItem(olMailItem)
        With obMail
            .To = eAddr
            .Subject = Subj
            .BodyFormat = olFormatPlain
            .Body = BodyTxt
            .Attachments.Add (fName)
            .Send
        End With
End Sub