B
Bob Barnes
I posted this last nite in Access.formscoding. A MVP has answered w/ a question & I jus
responded to that
The question..
I am using Office 2000 (Access to Excel) Automation which I have use
quite a bit
However, today, in using the "CopyFromRecordset" Excel method
I am receiving the "Subject" error above. There was no one else in th
Back-end to Lock the Query
I use a String Argument as part of this code. It fails at "CopyFromRecordset"..
Public Sub CopyTheData(strSql As String, strWorkBook As String,
Optional strWorkSheet As String, Optional strCellRef As String
On Error GoTo ProcErro
DoCmd.Hourglass True: bLock = Fals
Dim objXLApp As Object 'Excel.Applicatio
Dim objXLWb As Object 'Excel.Workboo
Dim objXLSheet As Object 'Excel.Workshee
Dim RS As DAO.Recordset, RT As DAO.Recordse
Dim fld As DAO.Field, I%, iSheets
'set rs from sql, table or quer
Set RS = CurrentDb.OpenRecordset(strSql, dbOpenSnapshot
'start Exce
Set objXLApp = CreateObject("Excel.Application"
'open workbook, error routine will create it if doesn't exis
'only create workbooks with 1 shee
iSheets = objXLApp.SheetsInNewWorkbook 'save user's settin
objXLApp.SheetsInNewWorkbook = 1 'set for only 1 shee
Set objXLWb = objXLApp.Workbooks.Open(strWorkBook
objXLApp.SheetsInNewWorkbook = iSheets 'restore user's settin
'select a worksheet, if sheet doesn't exis
'the error routine will add i
If strWorkSheet = "" The
strWorkSheet = "Sheet1
End I
'If Range is missing default to A
If strCellRef = "" Then strCellRef = "A1
'select desired workshee
Set objXLSheet = objXLWb.Worksheets("TheChart"
objXLSheet.Range("ATitle").Clea
objXLSheet.Range("ATitle") = Forms!frmMain!cboMgmt
& " For W/E (Saturday) " & Forms!frmMain!cboChartDat
objXLSheet.Range("Person").Clea
objXLSheet.Range("Person") = Forms!frmMain!cboMgmt.Column(1
'=
Set objXLSheet = objXLWb.Worksheets(strWorkSheet
objXLSheet.Range(strCellRef).Clear 'Is "TheData
objXLSheet.Range(strCellRef).CopyFromRecordset R
Set objXLSheet = objXLWb.Worksheets("TheChart"
'Save w
Outa
objXLWb.Save: objXLWb.Clos
'close up other rs object
If Not RS Is Nothing Then RS.Clos
Set RS = Nothin
Set objXLSheet = Nothin
Set objXLWb = Nothin
'quit Exce
If Not objXLApp Is Nothing Then objXLApp.Qui
Set objXLApp = Nothin
Exit Su
ProcError
Select Case Er
Case -2147417851 ' --> "The server threw an exception
'Answer what ???
Case 9 'Worksheet doesn't exis
objXLWb.Worksheets.Ad
Set objXLSheet = objXLWb.ActiveShee
objXLSheet.Name = strWorkShee
Resume Nex
Case 1004 'Workbook doesn't exist, make i
objXLApp.Workbooks.Ad
Set objXLWb = objXLApp.ActiveWorkboo
objXLWb.SaveAs strWorkBoo
Resume Nex
Case Els
DoCmd.Hourglass Fals
MsgBox Err.Number & " " & Err.DESCRIPTIO
Sto
Resume
End Selec
End Su
TIA - Bob
responded to that
The question..
I am using Office 2000 (Access to Excel) Automation which I have use
quite a bit
However, today, in using the "CopyFromRecordset" Excel method
I am receiving the "Subject" error above. There was no one else in th
Back-end to Lock the Query
I use a String Argument as part of this code. It fails at "CopyFromRecordset"..
Public Sub CopyTheData(strSql As String, strWorkBook As String,
Optional strWorkSheet As String, Optional strCellRef As String
On Error GoTo ProcErro
DoCmd.Hourglass True: bLock = Fals
Dim objXLApp As Object 'Excel.Applicatio
Dim objXLWb As Object 'Excel.Workboo
Dim objXLSheet As Object 'Excel.Workshee
Dim RS As DAO.Recordset, RT As DAO.Recordse
Dim fld As DAO.Field, I%, iSheets
'set rs from sql, table or quer
Set RS = CurrentDb.OpenRecordset(strSql, dbOpenSnapshot
'start Exce
Set objXLApp = CreateObject("Excel.Application"
'open workbook, error routine will create it if doesn't exis
'only create workbooks with 1 shee
iSheets = objXLApp.SheetsInNewWorkbook 'save user's settin
objXLApp.SheetsInNewWorkbook = 1 'set for only 1 shee
Set objXLWb = objXLApp.Workbooks.Open(strWorkBook
objXLApp.SheetsInNewWorkbook = iSheets 'restore user's settin
'select a worksheet, if sheet doesn't exis
'the error routine will add i
If strWorkSheet = "" The
strWorkSheet = "Sheet1
End I
'If Range is missing default to A
If strCellRef = "" Then strCellRef = "A1
'select desired workshee
Set objXLSheet = objXLWb.Worksheets("TheChart"
objXLSheet.Range("ATitle").Clea
objXLSheet.Range("ATitle") = Forms!frmMain!cboMgmt
& " For W/E (Saturday) " & Forms!frmMain!cboChartDat
objXLSheet.Range("Person").Clea
objXLSheet.Range("Person") = Forms!frmMain!cboMgmt.Column(1
'=
Set objXLSheet = objXLWb.Worksheets(strWorkSheet
objXLSheet.Range(strCellRef).Clear 'Is "TheData
objXLSheet.Range(strCellRef).CopyFromRecordset R
Set objXLSheet = objXLWb.Worksheets("TheChart"
'Save w
Outa
objXLWb.Save: objXLWb.Clos
'close up other rs object
If Not RS Is Nothing Then RS.Clos
Set RS = Nothin
Set objXLSheet = Nothin
Set objXLWb = Nothin
'quit Exce
If Not objXLApp Is Nothing Then objXLApp.Qui
Set objXLApp = Nothin
Exit Su
ProcError
Select Case Er
Case -2147417851 ' --> "The server threw an exception
'Answer what ???
Case 9 'Worksheet doesn't exis
objXLWb.Worksheets.Ad
Set objXLSheet = objXLWb.ActiveShee
objXLSheet.Name = strWorkShee
Resume Nex
Case 1004 'Workbook doesn't exist, make i
objXLApp.Workbooks.Ad
Set objXLWb = objXLApp.ActiveWorkboo
objXLWb.SaveAs strWorkBoo
Resume Nex
Case Els
DoCmd.Hourglass Fals
MsgBox Err.Number & " " & Err.DESCRIPTIO
Sto
Resume
End Selec
End Su
TIA - Bob