belairbilly
Programmer
I've written a Database that imports raw data from a mainframe general ledger system which includes account number, cost center, office, product, etc. and the balance from the previous end of month. The purpose of this system is to create a workbook for each department in the organization based upon the GL accounts that they have reponsibility to reconcile. There are approximately 12,000 GL accounts spread out amongst 20 or so departments. The user has a form that shows all the departments in the database and he(she) can select or many to export to excel. The code that accomplishes this basically captures the DeptID field from the Master and selects all the records in the Reconcilation file associated with it and builds a spreadsheet for that department to be emailed to them. It loops until all the selected departments are finished and builds a separate workbook in a folder on the harddrive.
Originally, I did all the formatting of the excel cells in the code module. I'll attach a copy of the spreadsheet. The entire process takes about 45 minutes which is quite lengthy, but I didn't have a better way to do this.
I am attempting to eliminate inline formatting of excel cells by using a blank template which is pre-formatted, then query the data from Access to dump into the appropriate cell range A6:I6 and down however many rows are necessary depending on the records returned by the query.
The next step is to save the template workbook as a separate workbook using the department name, thus preserving the integrity of the template. I'll highlight the piece of code that is not working. Got this from a book that a brief example of office automation, and I am trying to see if this change in philosophy will speed up the export process. I believe Omega mentioned that excel runs as an out of process server, which made me think the formatting of the cells in code was dragging down the whole scheme. If you guys could look at this and offer some insight on a better way to do this, I'd appreciate. Hope I've explained the purpose and provided enough information.
Private Sub BuildExportQuery(lngDeptID As Long)
On Error GoTo BuildExportQuery_Err
' Object Variables for Automation
Dim objXLApp As Excel.Application
Dim objXLBook As Excel.Workbook
Dim objXLSheet As Excel.Worksheet
Dim objXLRange As Excel.Range
Dim strWhere As String
Dim sSQL As String
Dim qdf As QueryDef
Dim rstAccounts As Recordset
Dim dbThis As Database
Dim varResults As Variant
Dim varReturn As Variant
Dim strDept As String
Const XLSName = "Template.XLS"
Const XLSPath = "C:\Reconciliation\"
'-------------------------------------------------------------
'Check to see if Reconciliation folder is set up on the PC
'If not, create a folder to use to save the spread sheets
'-------------------------------------------------------------
If Not Dir("C:\Reconciliation\nul", vbNormal) <> "" Then
MkDir ("C:\Reconciliation\")
End If
strPath = ("C:\Reconciliation\")
' Go Ahead and create an object from the XLS Template File
Set objXLBook = GetObject(XLSPath & XLSName)
Set objXLApp = objXLBook.Parent
Set objXLSheet = objXLBook.Worksheets("Sheet1")
objXLApp.Visible = True
objXLBook.Windows(1).Visible = True
'-----------------------------------------------------------------------
'Build dynamic export query
'-----------------------------------------------------------------------
strWhere = "Dept_T.Dept_ID = " & lngDeptID & ""
sSQL = "SELECT ReconMaster.Office, ReconMaster.Center AS [Cost Center]," & _
" ReconMaster.Account AS [Account Number], ReconMaster.Product" & _
" AS [Type], Account_T.Name AS Description," & _
" ReconMaster.Balance, Associate_T.Resp_Associate" & _
" AS [Resp By], Prepared_T.Associate" & _
" AS [Prep By], Reviewed_T.Rev_Associate" & _
" AS [Rev By], ReconMaster.Y, ReconMaster.Blank," & _
" ReconMaster.N, ReconMaster.Difference," & _
" ReconMaster.[30-89DAYS_Drs], ReconMaster.Blank1," & _
" ReconMaster.[30-89DAYS_Crs], ReconMaster.[>25K_Drs]," & _
" ReconMaster.Blank2, ReconMaster.[>25K_Crs]," & _
" ReconMaster.[>90DAYS_Drs], ReconMaster.Blank3," & _
" ReconMaster.[>90DAYS_Crs], Dept_T.Dept, Bcr_T.Current_Company, Bcr_T.SystemDate "
sSQL = sSQL & "FROM Bcr_T, Account_T INNER JOIN (Reviewed_T "
sSQL = sSQL & "INNER JOIN (Appl_T " & _
"INNER JOIN (Prepared_T " & _
"INNER JOIN (Dept_T " & _
"INNER JOIN (Associate_T " & _
"INNER JOIN ReconMaster "
sSQL = sSQL & "ON Associate_T.Resp_ID=ReconMaster.Resp_ID) " & _
"ON Dept_T.Dept_ID=ReconMaster.Dept_ID) " & _
"ON Prepared_T.Prep_ID=ReconMaster.Prep_ID) " & _
"ON Appl_T.Appl_ID=ReconMaster.Appl_ID) " & _
"ON Reviewed_T.Rev_ID=ReconMaster.Rev_ID) " & _
"ON Account_T.Account=ReconMaster.Account "
sSQL = sSQL & "WHERE " & strWhere & " ORDER BY Appl_T.Appl_ID, ReconMaster.Account," & _
" ReconMaster.Office, ReconMaster.Center, ReconMaster.Product"
'-----------------------------------------------------------------------
'Check for a change in query and replace the above query in the database
'-----------------------------------------------------------------------
Set dbThis = CurrentDb
Set qdf = dbThis.QueryDefs("qryExport")
qdf.Sql = sSQL
qdf.Close
RefreshDatabaseWindow
Set rstAccounts = dbThis.OpenRecordset("qryExport")
'-------------------------------------------------------------------
'If no records in the query, do not export workbook
'-------------------------------------------------------------------
If rstAccounts.RecordCount = 0 Then Exit Sub 'No selected records
varResults = rstAccounts.GetRows(31)
rstAccounts.Close
dbThis.Close
Set objXLRange = objXLSheet.Range("A6:I" & 6 + UBound(varResults, 2))
objXLRange.FormulaArray = objXLApp.Transpose(varResults)
objXLSheet.SaveAs strDept
objXLBook.SaveAs XLSPath & strDept & ".XLS"
objXLBook.Close
'strBank = objRS!Current_Company 'Save Bank Name
'strDate = objRS!SystemDate 'Save Recon Date
varReturn = SysCmd(acSysCmdSetStatus, "Now exporting Department..." & strDept)
Exit Sub
BuildExportQuery_Err:
MsgBox ("The following error occurred, " & Err.Number & " " & Err.Description)
xl.ActiveWorkbook.Close True, strPath & strDept & ".XLS"
Set xl = Nothing
End Sub
The error I'm getting is #13 data type mismatch after execution of the objXLRange.FormulaArray statement above.
Is there a way to upload the template workbook for you to see? If so let me how to do it.
Originally, I did all the formatting of the excel cells in the code module. I'll attach a copy of the spreadsheet. The entire process takes about 45 minutes which is quite lengthy, but I didn't have a better way to do this.
I am attempting to eliminate inline formatting of excel cells by using a blank template which is pre-formatted, then query the data from Access to dump into the appropriate cell range A6:I6 and down however many rows are necessary depending on the records returned by the query.
The next step is to save the template workbook as a separate workbook using the department name, thus preserving the integrity of the template. I'll highlight the piece of code that is not working. Got this from a book that a brief example of office automation, and I am trying to see if this change in philosophy will speed up the export process. I believe Omega mentioned that excel runs as an out of process server, which made me think the formatting of the cells in code was dragging down the whole scheme. If you guys could look at this and offer some insight on a better way to do this, I'd appreciate. Hope I've explained the purpose and provided enough information.
Private Sub BuildExportQuery(lngDeptID As Long)
On Error GoTo BuildExportQuery_Err
' Object Variables for Automation
Dim objXLApp As Excel.Application
Dim objXLBook As Excel.Workbook
Dim objXLSheet As Excel.Worksheet
Dim objXLRange As Excel.Range
Dim strWhere As String
Dim sSQL As String
Dim qdf As QueryDef
Dim rstAccounts As Recordset
Dim dbThis As Database
Dim varResults As Variant
Dim varReturn As Variant
Dim strDept As String
Const XLSName = "Template.XLS"
Const XLSPath = "C:\Reconciliation\"
'-------------------------------------------------------------
'Check to see if Reconciliation folder is set up on the PC
'If not, create a folder to use to save the spread sheets
'-------------------------------------------------------------
If Not Dir("C:\Reconciliation\nul", vbNormal) <> "" Then
MkDir ("C:\Reconciliation\")
End If
strPath = ("C:\Reconciliation\")
' Go Ahead and create an object from the XLS Template File
Set objXLBook = GetObject(XLSPath & XLSName)
Set objXLApp = objXLBook.Parent
Set objXLSheet = objXLBook.Worksheets("Sheet1")
objXLApp.Visible = True
objXLBook.Windows(1).Visible = True
'-----------------------------------------------------------------------
'Build dynamic export query
'-----------------------------------------------------------------------
strWhere = "Dept_T.Dept_ID = " & lngDeptID & ""
sSQL = "SELECT ReconMaster.Office, ReconMaster.Center AS [Cost Center]," & _
" ReconMaster.Account AS [Account Number], ReconMaster.Product" & _
" AS [Type], Account_T.Name AS Description," & _
" ReconMaster.Balance, Associate_T.Resp_Associate" & _
" AS [Resp By], Prepared_T.Associate" & _
" AS [Prep By], Reviewed_T.Rev_Associate" & _
" AS [Rev By], ReconMaster.Y, ReconMaster.Blank," & _
" ReconMaster.N, ReconMaster.Difference," & _
" ReconMaster.[30-89DAYS_Drs], ReconMaster.Blank1," & _
" ReconMaster.[30-89DAYS_Crs], ReconMaster.[>25K_Drs]," & _
" ReconMaster.Blank2, ReconMaster.[>25K_Crs]," & _
" ReconMaster.[>90DAYS_Drs], ReconMaster.Blank3," & _
" ReconMaster.[>90DAYS_Crs], Dept_T.Dept, Bcr_T.Current_Company, Bcr_T.SystemDate "
sSQL = sSQL & "FROM Bcr_T, Account_T INNER JOIN (Reviewed_T "
sSQL = sSQL & "INNER JOIN (Appl_T " & _
"INNER JOIN (Prepared_T " & _
"INNER JOIN (Dept_T " & _
"INNER JOIN (Associate_T " & _
"INNER JOIN ReconMaster "
sSQL = sSQL & "ON Associate_T.Resp_ID=ReconMaster.Resp_ID) " & _
"ON Dept_T.Dept_ID=ReconMaster.Dept_ID) " & _
"ON Prepared_T.Prep_ID=ReconMaster.Prep_ID) " & _
"ON Appl_T.Appl_ID=ReconMaster.Appl_ID) " & _
"ON Reviewed_T.Rev_ID=ReconMaster.Rev_ID) " & _
"ON Account_T.Account=ReconMaster.Account "
sSQL = sSQL & "WHERE " & strWhere & " ORDER BY Appl_T.Appl_ID, ReconMaster.Account," & _
" ReconMaster.Office, ReconMaster.Center, ReconMaster.Product"
'-----------------------------------------------------------------------
'Check for a change in query and replace the above query in the database
'-----------------------------------------------------------------------
Set dbThis = CurrentDb
Set qdf = dbThis.QueryDefs("qryExport")
qdf.Sql = sSQL
qdf.Close
RefreshDatabaseWindow
Set rstAccounts = dbThis.OpenRecordset("qryExport")
'-------------------------------------------------------------------
'If no records in the query, do not export workbook
'-------------------------------------------------------------------
If rstAccounts.RecordCount = 0 Then Exit Sub 'No selected records
varResults = rstAccounts.GetRows(31)
rstAccounts.Close
dbThis.Close
Set objXLRange = objXLSheet.Range("A6:I" & 6 + UBound(varResults, 2))
objXLRange.FormulaArray = objXLApp.Transpose(varResults)
objXLSheet.SaveAs strDept
objXLBook.SaveAs XLSPath & strDept & ".XLS"
objXLBook.Close
'strBank = objRS!Current_Company 'Save Bank Name
'strDate = objRS!SystemDate 'Save Recon Date
varReturn = SysCmd(acSysCmdSetStatus, "Now exporting Department..." & strDept)
Exit Sub
BuildExportQuery_Err:
MsgBox ("The following error occurred, " & Err.Number & " " & Err.Description)
xl.ActiveWorkbook.Close True, strPath & strDept & ".XLS"
Set xl = Nothing
End Sub
The error I'm getting is #13 data type mismatch after execution of the objXLRange.FormulaArray statement above.
Is there a way to upload the template workbook for you to see? If so let me how to do it.