HI Daniel
I was try to cut corners slightly by posting only the section that seems to be causing issues, I have put the whole procedure in below.
Regards,
- Sean
CODE
Public Function CreateInvoicesExcel(intOption As Integer) As Integer
Dim intRailsiteInv As Integer, intRadiositeInv As Integer, intWatersiteInv As Integer, intInvNo As Integer, intCompanyNo As Integer
Dim intDefaultInvNo As Integer, intTenantNo As Integer, intQS4Inv, intSanity As Integer, intError As Integer, intNoInvoices As Integer
Dim dbCurrDb As dao.Database, rstRentTable As dao.Recordset
Dim strTemplate As String, strPathname As String, strFileName As String, strInvoice As String, strBillingAddress As String
Dim varAddress As Variant
Dim dtInvoiceDate As Date, dtFinalDate As Date
Dim objBook As Excel.Workbook
Dim objSheet As Excel.Worksheet
If MsgBox("Are you sure that you are ready to produce current batch of invoices", vbYesNo, "Confirm Process") _
= vbNo Then Exit Function
Set dbCurrDb = CurrentDb
Select Case intOption
Case Is = 1
Set rstRentTable = dbCurrDb.OpenRecordset("tblMonthsInvoicing", dbopendynaset)
Case Is = 2
Set rstRentTable = dbCurrDb.OpenRecordset("tblAdHocInvoicing", dbopendynaset)
End Select
'Sanity Checks
intError = 0
intnoinvoice = 0
If rstRentTable.RecordCount = 0 Then
MsgBox "There are no invoices to be raised!", vbCritical, "Error"
intError = 1
GoTo EndofCreateInvoices
End If
intSanity = 0
Do Until rstRentTable.EOF
If rstRentTable("ToBeInvoiced") = -1 Then
If rstRentTable("nextpaymentdate") = "" Then
intSanity = 1
'intError = 1
End If
If IsNull(rstRentTable("nextpaymentdate")) = True Then
If intOption = 1 Then
intSanity = 1
'intError = 1
End If
End If
If IsNull(rstRentTable("Income")) = True Or IsNull(rstRentTable("VATValue")) = True Then
intSanity = 2
'intError = 2
End If
If rstRentTable("Income") + rstRentTable("VATValue") = 0 Then
intSanity = 2
'intError = 2
End If
End If
If rstRentTable("ToBeInvoiced") = -1 Then intNoInvoices = intNoInvoices + 1
If intSanity >= 1 Then Exit Do
rstRentTable.MoveNext
Loop
If intSanity = 2 Then
MsgBox "One Or More Invoices Have Not Got Valid Amounts Entered For Invoice Value or VAT - Please Review!", vbCritical, "Error"
intError = 1
GoTo EndofCreateInvoices
End If
If intOption = 2 Then GoTo EndOfSanityCheck
If intSanity = 1 Then
MsgBox "One Or More Invoices Have Not Got Dates Entered For The Next Invoice To Be Raised - Please Review!", vbCritical, "Error"
intError = 1
GoTo EndofCreateInvoices
End If
EndOfSanityCheck:
If intNoInvoices = 0 Then
MsgBox "There Are No Invoices Marked To Be Raised - Please Review!", vbCritical, "Error"
intError = 1
GoTo EndofCreateInvoices
End If
rstRentTable.MoveFirst
'End of Sanity Check
strPathname = DLookup("[Location]", "tblLocation", "[Database] = 'Backend'")
intDefaultInvNo = DLookup("[LastInvoiceNo]", "tblLatestInvoiceNo", "[Company] = '" & "Radiosite" & "'")
intRadiositeInv = InputBox("Enter first invoice number to be used for Radiosite: " & Chr(13) _
& "(The last one used was " & intDefaultInvNo, "Radiosite", intDefaultInvNo + 1)
intDefaultInvNo = DLookup("[LastInvoiceNo]", "tblLatestInvoiceNo", "[Company] = '" & "Railsite" & "'")
intRailsiteInv = InputBox("Enter first invoice number to be used for Railsite: " & Chr(13) _
& "(The last one used was " & intDefaultInvNo, "Railsite", intDefaultInvNo + 1)
intDefaultInvNo = DLookup("[LastInvoiceNo]", "tblLatestInvoiceNo", "[Company] = '" & "Watersite" & "'")
intWatersiteInv = InputBox("Enter first invoice number to be used for Watersite: " & Chr(13) _
& "(The last one used was " & intDefaultInvNo, "Watersite", intDefaultInvNo + 1)
intDefaultInvNo = DLookup("[LastInvoiceNo]", "tblLatestInvoiceNo", "[Company] = '" & "QS4" & "'")
intQS4Inv = InputBox("Enter first invoice number to be used for QS4: " & Chr(13) _
& "(The last one used was " & intDefaultInvNo, "QS4", intDefaultInvNo + 1)
dtInvoiceDate = InputBox("Enter the Date that these invoices are to be issued on: ", "Invoice Date")
If IsNull(dtInvoiceDate) = True Then dtInvoiceDate = Date
rstRentTable.MoveFirst
Do While Not rstRentTable.EOF
If rstRentTable("ToBeInvoiced").Value <> -1 Then GoTo EndOfDoLoop
intCompanyNo = DLookup("[CompanyNo]", "tblPortfolio", "[Portfolio]='" & rstRentTable("invoicingDepartment") & "'")
Select Case rstRentTable("InvoicingDepartment")
Case Is = "Radiosite"
strTemplate = strPathname & "\InvoiceTemplates\RadiositeRent(Blank).xls"
strInvoice = intCompanyNo & "/" & Right(Date, 2) & "/" & intRadiositeInv
strFileName = strPathname & "\Invoices\" & intCompanyNo & "." & Right(Date, 2) & "." & intRadiositeInv & ".xls"
intInvNo = intRadiositeInv
intRadiositeInv = intRadiositeInv + 1
Case Is = "Railsite"
strTemplate = strPathname & "\InvoiceTemplates\RailsiteRent(Blank).xls"
strInvoice = intCompanyNo & "/" & Right(Date, 2) & "/" & intRailsiteInv
strFileName = strPathname & "\Invoices\" & intCompanyNo & "." & Right(Date, 2) & "." & intRailsiteInv & ".xls"
intInvNo = intRailsiteInv
intRailsiteInv = intRailsiteInv + 1
Case Is = "Watersite"
strTemplate = strPathname & "\InvoiceTemplates\WatersiteRent(Blank).xls"
strInvoice = intCompanyNo & "/" & Right(Date, 2) & "/" & intWatersiteInv
strFileName = strPathname & "\Invoices\" & intCompanyNo & "." & Right(Date, 2) & "." & intWatersiteInv & ".xls"
intInvNo = intWatersiteInv
intWatersiteInv = intWatersiteInv + 1
Case Is = "QS4"
strTemplate = strPathname & "\InvoiceTemplates\QS4Rent(Blank).xls"
strInvoice = intCompanyNo & "/" & Right(Date, 2) & "/" & intQS4Inv
strFileName = strPathname & "\Invoices\" & intCompanyNo & "." & Right(Date, 2) & "." & intQS4Inv & ".xls"
intInvNo = intQS4Inv
intQS4Inv = intQS4Inv + 1
Case Else
MsgBox "Please confirm which department is to invoice for site ref: " _
& rstRentTable("RefNo")
intError = 1
GoTo EndofCreateInvoices
End Select
FileCopy strTemplate, strFileName
Set objBook = GetObject(strFileName)
Set objSheet = objBook.Worksheets(1)
intTenantNo = DLookup("TblTenants_ID", "tblTenancyDetails", "[TenancyNo] = " & rstRentTable("TenancyNo"))
strBillingAddress = rstRentTable("BillingAddress")
With objSheet
If intOption = 1 Then
If rstRentTable("EffectivePaymentDate") >= dtInvoiceDate Then
dtFinalDate = rstRentTable("EffectivePaymentDate")
Else
dtFinalDate = dtInvoiceDate
End If
'.Cells(9, 7) = rstRentTable("EffectivePaymentDate") ' Invoice Due Date
.Cells(9, 7) = dtFinalDate
Else
.Cells(9, 7) = rstRentTable("PaymentDate") ' Invoice Due Date
End If
.Cells(10, 7) = strInvoice ' Invoice Number
.Cells(11, 7) = dtInvoiceDate ' Invoice Date
.Cells(13, 7) = rstRentTable("RefNo") ' Shere Ref No
.Cells(14, 7) = rstRentTable("TenantCellRef") ' Operator Cell No
.Cells(17, 1) = "Ref: " & rstRentTable("Reference") 'Re: O2 install at High Man
.Cells(18, 1) = "Address: " & DLookup("[Address]", "tbloriginaldata", _
"[TenancyNo]=" & rstRentTable("TenancyNo")) ' Address of site
.Cells(22, 1) = rstRentTable("Description") ' Description of what is being invoiced
.Cells(22, 6) = DLookup("[TaxRate]", "tblTaxCodes", "[TaxCode]='" & rstRentTable("TaxCode") & "'") * 100 'VAT Rate
.Cells(22, 7) = CCur(rstRentTable("Income")) ' Income for site
.Cells(22, 8) = CCur(rstRentTable("VatValue")) 'VAT on Sale
If (CCur(rstRentTable("Income")) + CCur(rstRentTable("VatValue"))) < 0 Then .Cells(10, 6) = "Credit Note No:"
' MsgBox rstRentTable("Tenant")
varAddress = ""
varAddress = GetTenantAddress(intTenantNo, strBillingAddress)
.Cells(9, 1) = varAddress ' Invoice Address
.Cells(35, 1) = rstRentTable("AdHocText")
rstRentTable.Edit
rstRentTable("InvoiceNo").Value = strInvoice
rstRentTable("InvoiceDate").Value = dtInvoiceDate
rstRentTable.Update
End With
objBook.Save
objBook.Application.DisplayAlerts = True
objBook.Windows(1).Visible = True
objBook.Close savechanges:=True
Set objSheet = Nothing
Set objBook = Nothing
GoTo EndOfDoLoop
EndOfDoLoop:
rstRentTable.MoveNext
Loop
Set rstRentTable = Nothing
Set rstRentTable = dbCurrDb.OpenRecordset("tblLatestInvoiceno", dbopendynaset)
With rstRentTable
.MoveFirst
Do While Not rstRentTable.EOF
Select Case rstRentTable("Company")
Case Is = "Radiosite"
.Edit
rstRentTable("LastInvoiceNo").Value = intRadiositeInv - 1
.Update
Case Is = "Railsite"
.Edit
rstRentTable("LastInvoiceNo").Value = intRailsiteInv - 1
.Update
Case Is = "Watersite"
.Edit
rstRentTable("LastInvoiceNo").Value = intWatersiteInv - 1
.Update
Case Is = "QS4"
.Edit
rstRentTable("LastInvoiceNo").Value = intQS4Inv - 1
.Update
End Select
rstRentTable.MoveNext
Loop
End With
GoTo EndofCreateInvoices
EndofCreateInvoices:
Set rstRentTable = Nothing
Set rstRentTable = Nothing
Set dbCurrDb = Nothing
If intError = 0 Then
Select Case intOption
Case Is = 1
ProduceSageFile dtInvoiceDate
' UpdateNextInvDate
Case Is = 2
ProduceSageAdHocFile dtInvoiceDate
End Select
CreateInvoicesExcel = 0
Else
CreateInvoicesExcel = 1
End If
End Function