P
pokdbz
Here is the error
Run-time error '-2147417851 (80010105)':
Method 'CopyFromRecordset' of object 'Range' failed
Below where the * are is where the debug is showing the error.
Any idea what the problem is?
Dim qdf As DAO.QueryDef
Set qdf = CurrentDb.QueryDefs("PHQChartQuery")
qdf.Parameters("whichSSN") = Me.SSN
qdf.Execute
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim db As Database
Dim rs As Recordset
Dim intLastCol As Integer
Const conMAX_ROWS = 20000
Const conSHT_NAME = "PHQChartQuery"
Const conWKB_NAME = "C:\\PHQChart.xls"
Set db = CurrentDb
Set objXL = New Excel.Application
Set rs = db.OpenRecordset("MakeTablePHQ", dbOpenSnapshot)
With objXL
.Visible = True
Set objWkb = .Workbooks.Open(conWKB_NAME)
On Error Resume Next
Set objSht = objWkb.Worksheets(conSHT_NAME)
If Not Err.Number = 0 Then
Set objSht = objWkb.Worksheets.Add
objSht.Name = conSHT_NAME
End If
Err.Clear
On Error GoTo 0
intLastCol = objSht.UsedRange.Columns.Count
With objSht
.Range(.Cells(1, 1), .Cells(conMAX_ROWS, _
intLastCol)).ClearContents
.Range(.Cells(1, 1), _
.Cells(1, rs.Fields.Count)).Font.Bold = True
**********************************
.Range("A2").CopyFromRecordset rs
**********************************
End With
End With
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
Set rs = Nothing
Set db = Nothing
Run-time error '-2147417851 (80010105)':
Method 'CopyFromRecordset' of object 'Range' failed
Below where the * are is where the debug is showing the error.
Any idea what the problem is?
Dim qdf As DAO.QueryDef
Set qdf = CurrentDb.QueryDefs("PHQChartQuery")
qdf.Parameters("whichSSN") = Me.SSN
qdf.Execute
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim db As Database
Dim rs As Recordset
Dim intLastCol As Integer
Const conMAX_ROWS = 20000
Const conSHT_NAME = "PHQChartQuery"
Const conWKB_NAME = "C:\\PHQChart.xls"
Set db = CurrentDb
Set objXL = New Excel.Application
Set rs = db.OpenRecordset("MakeTablePHQ", dbOpenSnapshot)
With objXL
.Visible = True
Set objWkb = .Workbooks.Open(conWKB_NAME)
On Error Resume Next
Set objSht = objWkb.Worksheets(conSHT_NAME)
If Not Err.Number = 0 Then
Set objSht = objWkb.Worksheets.Add
objSht.Name = conSHT_NAME
End If
Err.Clear
On Error GoTo 0
intLastCol = objSht.UsedRange.Columns.Count
With objSht
.Range(.Cells(1, 1), .Cells(conMAX_ROWS, _
intLastCol)).ClearContents
.Range(.Cells(1, 1), _
.Cells(1, rs.Fields.Count)).Font.Bold = True
**********************************
.Range("A2").CopyFromRecordset rs
**********************************
End With
End With
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
Set rs = Nothing
Set db = Nothing