HELP WITH A MACRO

Copper Contributor

I have been trying for weeks to get this working but to no avail.  I have a work book that contains three sheets; an invoice, the customer database and an invoice record.  All I want to be able to do is create an invoice, and be able to save it as an Excel, a PDF and email it as a PDF to the address stated in column J of the database but I just can't seem to make this happen.  Ideally, I want the invoices and pdfs saved as the name in D1 and the W/E Date which is stated in Cell C12.  Every time I try, I keep coming up with error messages.  Please, please can someone help.  The below is the coding I have used but to no avail.

 

Option Explicit
Dim invno As Long
Dim custname As String
Dim amt As Currency
Dim dt_issue As Date
Dim nextrec As Range
Dim path As String
Dim fname As String

Sub RecordofInvoice()

invno = Range("B2")
custname = Range("D1")
amt = Range("E38")
dt_issue = Range("B4")

Set nextrec = Sheet3.Range("A1048576").End(xlUp).Offset(1, 0)

nextrec = invno
nextrec.Offset(0, 1) = custname
nextrec.Offset(0, 2) = amt
nextrec.Offset(0, 3) = dt_issue

End Sub

Sub SaveInv()

Dim shp As Shape

path = "" 'C:\Users\joann\OneDrive - name\folder\folder\folder\folder\Invoice Templates
invno = Range("B2")
dt_issue = Range("B4")
custname = Range("D1")
fname = invno & " - " & custname

Application.DisplayAlerts = False

Sheet1.Copy

For Each shp In ActiveSheet.Shapes
If shp.Type <> msoPicture Then shp.Delete 'This line is modified so that is doesn't delete the logo
Next shp

With ActiveWorkbook
.Sheets(1).Name = "Invoice"
.SaveAs Filename:=path & fname, FileFormat:=51
.Close
End With

Application.DisplayAlerts = True

Set nextrec = Sheet3.Range("A1048576").End(xlUp).Offset(1, 0)
nextrec = invno
nextrec.Offset(0, 1) = custname
nextrec.Offset(0, 2) = amt
nextrec.Offset(0, 3) = dt_issue

Sheet3.Hyperlinks.Add anchor:=nextrec.Offset(0, 7), Address:=path & fname & ".xlsx"
End Sub

Sub SaveAspdf()

path = "C:\Users\joann\OneDrive - name\folder\folder\folder\folder\Invoices"
invno = Range("B2")
custname = Range("D1")
fname = invno & " - " & custname

ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
IgnorePrintAreas:=False, _
Filename:=path & fname

Set nextrec = Sheet3.Range("A1048576").End(xlUp).Offset(1, 0)
nextrec = invno
nextrec.Offset(0, 1) = custname
nextrec.Offset(0, 2) = amt
nextrec.Offset(0, 3) = dt_issue

Sheet3.Hyperlinks.Add anchor:=nextrec.Offset(0, 6), Address:=path & fname & ".pdf"

End Sub

Sub StartNewInvoice()

invno = Range("B2")

Range("B2, B4, D1:D6, A18:E43,B49:B51").ClearContents

MsgBox "Your next invoice number is " & invno + 1

Range("B2") = invno + 1
Range("D1").Select

ThisWorkbook.Save
End Sub


Sub EmailAspdf()

Dim EApp As Object
Set EApp = CreateObject("Outlook.Application")

Dim EItem As Object

path = " 'C:\Users\joann\OneDrive - name\folder\folder\folder\folder\Invoices"
invno = Range("B2")
custname = Range("D1")
fname = invno & " - " & custname
amt = Range("E43")
dt_issue = Range("B4")

ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
IgnorePrintAreas:=False, _
Filename:=path & fname

Set nextrec = Sheet3.Range("A1048576").End(xlUp).Offset(1, 0)

nextrec = invno
nextrec.Offset(0, 1) = custname
nextrec.Offset(0, 2) = amt
nextrec.Offset(0, 3) = dt_issue
nextrec.Offset(0, 8) = Now

Sheet3.Hyperlinks.Add anchor:=nextrec.Offset(0, 6), Address:=path & fname & ".pdf"

Set EItem = EApp.CreateItem(0)

With EItem

.To = Range("E6")

.Subject = "Invoice No: " & Range("D1")

.Body = "Please find invoice attached."

.Attachment.Add (path & fname & ".pdf")

.Display

End With
Exit Sub

 

End Sub

 

 

1 Reply

@JoMc4 

It seems like there are some typos and errors in your code that might be causing the issues you are facing. Here are some suggestions to help you fix them:

  1. In the SaveInv() sub, you are trying to delete all shapes in the copied sheet except for pictures. However, the syntax for the If statement is incorrect. Change If shp.Type <> msoPicture Then shp.Delete to If shp.Type <> msoPicture Then shp.Delete End If.

  2. In the SaveAspdf() sub, the path variable for saving the PDF does not include a backslash at the end of the folder path. Change path = "C:\Users\joann\OneDrive - name\folder\folder\folder\folder\Invoices" to path = "C:\Users\joann\OneDrive - name\folder\folder\folder\folder\Invoices\".

  3. In the EmailAspdf() sub, you have a typo in the path variable. Remove the extra space before the opening single quote in the path string. Change path = " 'C:\Users\joann\OneDrive - name\folder\folder\folder\folder\Invoices" to path = "C:\Users\joann\OneDrive - name\folder\folder\folder\folder\Invoices\".

  4. In the EmailAspdf() sub, you are missing a closing parenthesis in the line nextrec.Offset(0, = Now. Change it to nextrec.Offset(0, 4) = Now.

  5. In the EmailAspdf() sub, you are not setting the amt and dt_issue variables before exporting the PDF and updating the invoice record. Add the following lines before exporting the PDF:

 

amt = Range("E38")
dt_issue = Range("B4")

 

  • In the EmailAspdf() sub, you are not updating the invoice record for the date and time the email was sent. Add the following line after updating the invoice record for the PDF:

 

nextrec.Offset(0, 5) = Now​

 

With these changes, your code should work as expected. Let me know if you have any further questions or issues.