Do you know how I can prevent the Run time error '3010' table 'FA_ledger_report' already exists
FA_ledger_report is actually the following Union query:
SELECT COSTCENTER AS [COST CENTER],
SAR_CATEGORY AS [SAR],
ASSET_NUMBER AS [ASSET NUMBER],
ASSET_DESC AS [ASSET DESCRIPTION],
VENDOR_NAME AS [VENDOR NAME],
INVOICE_NUMBER AS [INVOICE NUMBER],
Format(BOOK_COST, "#,##0.00;(#,##0.00)") AS [BOOK COST],
Format(BOOK_ACCUM_DEPR, "#,##0.00;(#,##0.00)") AS [BOOK ACCUM DEPR],
Format(CURR_DEPR, "#,##0.00;(#,##0.00)") AS [CURR DEPR],
Format(YTD_DEPR, "#,##0.00;(#,##0.00)")AS [YTD DEPR],
Format(NET_BOOK_VALUE, "#,##0.00;(#,##0.00)") AS [NET BOOK VALUE],
Format(BEGIN_DEPR, "mm/yyyy") AS [BEGIN DEPR],
Format(DEPR_LIFE, "yy/mm") AS [DEPR LIFE],
LOCATION_ID, DESCRIPTION, ADDRESS2, CITY,STATE, ZIP, REPORT_RUN_DATE,
"" AS [Remarks/Comments]
from tblFaLedgerBranch
UNION SELECT "", "", "", "","","",
"___________________",
"___________________",
"___________________",
"___________________",
"___________________",
"", "", "", "", "", "", "", "", "",""
from tblFaLedgerBranch
group by COSTCENTER
UNION SELECT "", "", "", "","","",
Format(sum(BOOK_COST), "#,##0.00;(#,##0.00)"),
Format(sum(BOOK_ACCUM_DEPR), "#,##0.00;(#,##0.00)"),
Format(sum(CURR_DEPR), "#,##0.00;(#,##0.00)"),
Format(sum(YTD_DEPR), "#,##0.00;(#,##0.00)"),
Format(sum(NET_BOOK_VALUE), "#,##0.00;(#,##0.00)"),
"", "", "", "", "", "", "", "", "",""
from tblFaLedgerBranch
group by COSTCENTER
UNION select "","",
"", INSTRUCTIONS,"", "", "", "","","", "", "", "", "", "", "", "", "", "","",""
from tblInstuctions
GROUP BY INSTRUCTIONS
ORDER BY 1 DESC , 2;
--------------------------------------------------------------------------------------------------------------
Public Function prtFaLedgerExcel()
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
Dim fname As String
Dim sql As String
Dim fpath As String
Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
fpath = "C:\FALEDGER\REPORTS\OUTPUTS\"
MsgBox ("The process of conversion FA Ledger Report to excel format is started. Please wait ... ")
'1. Open cost center table and pass cost center as a parameter
rs.Open "SELECT tblCostCenter.[COSTCENTER] FROM tblCostCenter GROUP BY tblCostCenter.[COSTCENTER];", cn
Do Until rs.EOF
fname = fpath & "fa_ledger_report" & "_" & rs("COSTCENTER") & ".xls"
'2. insert records to tblFaLedgerBranch only for selected cost center
sql = "INSERT INTO tblFaLedgerBranch ( COSTCENTER, SAR_CATEGORY, ASSET_NUMBER, ASSET_DESC, VENDOR_NAME, INVOICE_NUMBER, BOOK_COST, BOOK_ACCUM_DEPR, CURR_DEPR, YTD_DEPR, NET_BOOK_VALUE, BEGIN_DEPR, DEPR_METHOD_CODE, DEPR_LIFE, LOCATION_ID, DESCRIPTION, ADDRESS2, CITY, STATE, ZIP,REPORT_RUN_DATE,COMMENTS )" & _
"SELECT COSTCENTER, SAR_CATEGORY, ASSET_NUMBER, ASSET_DESC, VENDOR_NAME, INVOICE_NUMBER, BOOK_COST, BOOK_ACCUM_DEPR, CURR_DEPR, YTD_DEPR, NET_BOOK_VALUE, BEGIN_DEPR, DEPR_METHOD_CODE, DEPR_LIFE, " & _
"LOCATION_ID , Description, ADDRESS2, CITY, State, ZIP, REPORT_RUN_DATE, '' " & _
"FROM dbo_FA_LEDGER_LOCATION " & _
"WHERE (dbo_FA_LEDGER_LOCATION.COSTCENTER = '" & rs(0) & "')"
DoCmd.SetWarnings False
DoCmd.RunSQL sql
'3. Convert query to excel format
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Fa_ledger_report", fname, True <--- the compiler stops here on this hightlighted line in yellow
If isFileExist(fname) Then StartDocLN fname
'4. Drop temp table
sql = "DELETE tblFaLedgerBranch FROM tblFaLedgerBranch"
DoCmd.RunSQL sql
sql = ""
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
Set cn = Nothing
MsgBox ("The process of conversion FA Ledger Report to excel format is completed.")
'If isFileExist(fname) Then StartDocLN fname
DoCmd.SetWarnings True
End Function
Private Sub StartDocLN(filename)
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim xlWS As Excel.Worksheet
'open excel template
Set xlApp = New Excel.Application
'xlApp.Visible = True
Set xlWB = xlApp.Workbooks.Open(filename)
Set xlWS = xlWB.Worksheets(1)
xlWS.Columns.AutoFit
xlWS.Range("G2:K16635").NumberFormat = "#,##0.00"
xlWS.Range("G2:K16635").Value = xlWS.Range("G2:K16635").Value
xlApp.ScreenUpdating = True
End Sub
|
