I'm building an Excel spreadsheet from data in an Access query. The query returns a set of records where the rows are identified by the "Item" and "Title" fields, and the columns are identified by the "DateRange" and "Activity" fields, and the "LD_Name" and "LD_Num" fields are text fields which contain the values for the cells within the matrix. There are records which contain NULL values in those fields, or there may be multiple records for a particular combination of row/column. The loop that populates each of these cells works properly.
Private Sub cmd_Output_Click() Dim intCount As Integer Dim db As DAO.Database Dim qdf As DAO.QueryDef Dim rs As DAO.Recordset Dim xl As Excel.Application Dim wbk As Excel.Workbook Dim sht As Excel.Worksheet Dim intRecCount As Integer Dim strItem As String Dim strDateRange As String Dim strActivity As String Dim intRow As Integer, intCol As Integer, intLoop As Integer On Error GoTo ProcError 'Check to make sure at least on focus category item is selected intCount = DSum("IsSelected", "qry_frm_LD_Act_Matrix_sub_Focus_Category_Items") If intCount = 0 Then MsgBox "Select at least one Focus Category Item to include in the output" Exit Sub End If 'Check to make sure that at least 1 activity is selected intCount = DSum("IsSelected", "qry_frm_LD_Act_Matrix_sub_Activities") If intCount = 0 Then MsgBox "Select at least one Focus Category Item to include in the output" Exit Sub End If 'Open the recordset for output Set db = CurrentDb Set qdf = CurrentDb.QueryDefs("qry_frm_LD_Act_Matrix_Output") qdf.Parameters(0) = Me.cbo_Fiscal_Year Set rs = qdf.OpenRecordset If Not rs.EOF Then rs.MoveLast intRecCount = rs.RecordCount rs.MoveFirst End If qdf.Close Set qdf = Nothing 'Open Excel and create a new workbook Set xl = CreateObject("excel.application") xl.Visible = True Set wbk = xl.Workbooks.Add Set sht = wbk.Sheets(1) 'Loop through the recordset building the Excel spreadsheet intRow = 2 Form_frm_Status.StatusUpdate message:="Building spreadsheet!" While Not rs.EOF DoEvents Form_frm_Status.StatusUpdate PctComplete:=rs.AbsolutePosition / intRecCount 'for each record, check to see whether to shift to a new row for a new focus category Item If rs("Item") <> strItem Then intRow = intRow + 1 strItem = rs("Item") 'If a new row, post the Row headings sht.Cells(intRow, 1) = rs("Item") sht.Cells(intRow, 2) = rs("Title") intCol = 2 End If 'For each record, check to see whether to shift to a new column If rs("DateRange") <> strDateRange Or rs("Activity") <> strActivity Then intCol = intCol + 1 strDateRange = rs("DateRange") strActivity = rs("Activity") 'Only need to worry about column headers for first row If intRow = 3 Then sht.Cells(1, intCol) = rs("Activity") sht.Cells(2, intCol) = rs("DateRange") End If End If sht.Cells(intRow, intCol).Activate If rs("ACT_LD_ID") <> "" Then sht.Cells(intRow, intCol) = sht.Cells(intRow, intCol) & "- " & rs("LD_Name") & " (" & rs("LD_Num") & ")" & vbCrLf End If rs.MoveNext Wend 'Format the various rows and columns' Form_frm_Status.StatusUpdate "Formatting spreadsheet" sht.Rows(1).Select With Selection .Activate .WrapText = True End With sht.Rows(2).Select With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium End With sht.Columns(1).Select With Selection .ColumnWidth = 10 End With sht.Columns(2).Select With Selection .ColumnWidth = 50 .WrapText = True End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlMedium End With sht.Range("C3").Select sht.Range("C3").Activate ActiveWindow.FreezePanes = True For intLoop = 3 To intCol sht.Columns(intLoop).Select With Selection .ColumnWidth = 50 .WrapText = True End With Next For intLoop = 3 To intRow sht.Rows(intLoop).Select With Selection .VerticalAlignment = xlTop End With NextProcExit: If Not wbk Is Nothing Then Set wbk = Nothing If Not xl Is Nothing Then xl.Visible = True Set xl = Nothing End If If Not rs Is Nothing Then rs.Close Set rs = Nothing End If Form_frm_Status.CloseForm MsgBox "Done!" Exit SubProcError: If Err.Number = 91 Then Set wbk = xl.ActiveWorkbook Set sht = wbk.ActiveSheet Resume Else Debug.Print Err.Number, Err.Description MsgBox Err.Number & vbCrLf & Err.Description, vbOKOnly, "cmd_Output_to_Excel" Resume ProcExit End IfEnd Sub
Following that loop, there is a series of statements, starting on line 94, which should format the spreadsheet, but which frequently raises an error (#462, The remote server machine does not exist of is unavailable) when it gets to line 95 (With Selection). This generally occurs the 2nd and subsequent times I run the code after the form that contains the command button is opened.
What is interesting is that the first time the code is run, it generally runs to completion, with the following issues:
1. the FreezePanes line (119) does not appear to work properly. Although the left 2 columns are frozen in place, the top two rows are not.
2. When I close the Excel application after it has completed the process, there is still a reference to the Excel object in the Task Manager processes tab. When I close Excel after the process generates the #462 error, is generated, there is no Excel process still running.
So, my questions are:
1. What am I doing wrong that is causing the #462 error to run
2. Why isn't the FreezePanes method working the way I anticipate
I'm sure this has something to do with an explicit reference to an Excel object, but cannot figure out what I'm missing.
You have lots of unqualified references to selection, which is the cause of your first problem. Try this (after restarting your machine to clear rogue instance of Excel):
Private Sub cmd_Output_Click() Dim intCount As Integer Dim db As DAO.Database Dim qdf As DAO.QueryDef Dim rs As DAO.Recordset Dim xl As Excel.Application Dim wbk As Excel.Workbook Dim sht As Excel.Worksheet Dim intRecCount As Integer Dim strItem As String Dim strDateRange As String Dim strActivity As String Dim intRow As Integer, intCol As Integer, intLoop As Integer On Error GoTo ProcError 'Check to make sure at least on focus category item is selected intCount = DSum("IsSelected", "qry_frm_LD_Act_Matrix_sub_Focus_Category_Items") If intCount = 0 Then MsgBox "Select at least one Focus Category Item to include in the output" Exit Sub End If 'Check to make sure that at least 1 activity is selected intCount = DSum("IsSelected", "qry_frm_LD_Act_Matrix_sub_Activities") If intCount = 0 Then MsgBox "Select at least one Focus Category Item to include in the output" Exit Sub End If 'Open the recordset for output Set db = CurrentDb Set qdf = CurrentDb.QueryDefs("qry_frm_LD_Act_Matrix_Output") qdf.Parameters(0) = Me.cbo_Fiscal_Year Set rs = qdf.OpenRecordset If Not rs.EOF Then rs.MoveLast intRecCount = rs.RecordCount rs.MoveFirst End If qdf.Close Set qdf = Nothing 'Open Excel and create a new workbook Set xl = CreateObject("excel.application") xl.Visible = True Set wbk = xl.Workbooks.Add Set sht = wbk.Sheets(1) 'Loop through the recordset building the Excel spreadsheet intRow = 2 Form_frm_Status.StatusUpdate Message:="Building spreadsheet!" While Not rs.EOF DoEvents Form_frm_Status.StatusUpdate PctComplete:=rs.AbsolutePosition / intRecCount 'for each record, check to see whether to shift to a new row for a new focus category Item If rs("Item") <> strItem Then intRow = intRow + 1 strItem = rs("Item") 'If a new row, post the Row headings sht.Cells(intRow, 1) = rs("Item") sht.Cells(intRow, 2) = rs("Title") intCol = 2 End If 'For each record, check to see whether to shift to a new column If rs("DateRange") <> strDateRange Or rs("Activity") <> strActivity Then intCol = intCol + 1 strDateRange = rs("DateRange") strActivity = rs("Activity") 'Only need to worry about column headers for first row If intRow = 3 Then sht.Cells(1, intCol) = rs("Activity") sht.Cells(2, intCol) = rs("DateRange") End If End If sht.Cells(intRow, intCol).Activate If rs("ACT_LD_ID") <> "" Then sht.Cells(intRow, intCol) = sht.Cells(intRow, intCol) & "- " & rs("LD_Name") & " (" & rs("LD_Num") & ")" & vbCrLf End If rs.MoveNext Wend 'Format the various rows and columns' Form_frm_Status.StatusUpdate "Formatting spreadsheet" sht.Rows(1).WrapText = True With sht.Rows(2).Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium End With sht.Columns(1).ColumnWidth = 10 With sht.Columns(2) .ColumnWidth = 50 .WrapText = True With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlMedium End With End With sht.Range("C3").Select xlapp.ActiveWindow.FreezePanes = True For intLoop = 3 To intCol With sht.Columns(intLoop) .ColumnWidth = 50 .WrapText = True End With Next For intLoop = 3 To intRow sht.Rows(intLoop).VerticalAlignment = xlTop NextProcExit: If Not wbk Is Nothing Then Set wbk = Nothing If Not xl Is Nothing Then xl.Visible = True Set xl = Nothing End If If Not rs Is Nothing Then rs.Close Set rs = Nothing End If Form_frm_Status.CloseForm MsgBox "Done!" Exit SubProcError: If Err.Number = 91 Then Set wbk = xl.ActiveWorkbook Set sht = wbk.ActiveSheet Resume Else Debug.Print Err.Number, Err.Description MsgBox Err.Number & vbCrLf & Err.Description, vbOKOnly, "cmd_Output_to_Excel" Resume ProcExit End IfEnd Sub
Thanks. That solved the error message and the rogue Excel issue. That's what I get for pretty much copying a macro I created in excel using the Record Macro functionality.
The FreezePanes line is still not working properly. But I think that ought to be another question, so I'll post it seperately.
0
Question has a verified solution.
Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.
Squarespace’s all-in-one platform gives you everything you need to express yourself creatively online, whether it is with a domain, website, or online store. Get started with your free trial today, and when ready, take 10% off your first purchase with offer code 'EXPERTS'.
Scott C