|
Question : Using CopyFromRecordset with recordset yields a blank worksheet. Urgent!
|
|
Ultimate Guru's!
Can't figure it out. This should be ok and the code runs fine, but the worksheet keeps turning up empty. I have a little extra code from previous experiments that enumerated through the record set but it was way too slow. Now I am trying the CopyFromRecordset method because its supposed to rock. Can anyone see a problem in the code? Many thanks,
Ted
Ye Olde' code=======================
Public Function QryExcel(Qry As String, Optional FolderPath As String, Optional Filename As String) As Boolean ' 'This code is used 'to create a excel chart/worksheet using Automation from within Access 'Requires a reference to Microsoft Excel Objects Library and to the Microsoft DAO 3.6 library
QryExcel = False On Error GoTo Err_Handler Dim I As Integer, X As Integer, Y As Integer, Z As Integer Dim RCount As Integer Dim FCount As Integer Dim objExcel As Excel.Application Dim objWorkbook As Excel.Workbook Dim objWorksheet As Excel.Worksheet Dim tblName As String Dim db As DAO.Database Dim rs As DAO.Recordset Dim QD As DAO.QueryDef Dim SQLcmd As String Dim fld As Field Dim RowName As String Dim RowData As String Dim RowNameTitle As String Dim RowDataTitle As String Dim RowNameField As String Dim RowDataField1 As String Dim RowDataField2 As String Dim intMaxCol As Integer Dim intMaxRow As Integer Dim Title As String Dim F As Integer Const conRANGE = "RangeForRS" Const TitleStartRow As Integer = 2 Const BodyStartRow As Integer = 5 Const One As Integer = 1
tblName = Qry
Set db = CurrentDb Set QD = db.QueryDefs(Qry) SQLcmd = QD.Sql Set rs = db.OpenRecordset(SQLcmd, dbOpenSnapshot)
If rs.EOF Then MsgBox "Sorry - No Data Found in " & Qry & ".", vbInformation Exit Function Else rs.MoveLast rs.MoveFirst RCount = rs.RecordCount 'Get the total number of records intMaxRow = RCount End If
FCount = rs.Fields.Count 'Get the number of fields intMaxCol = FCount
'Set objExcel = GetObject("", "excel.application") On Error Resume Next Set objExcel = GetObject(FolderPath & Filename, "excel.application") If Err.Number > 0 Then Set objExcel = GetObject("", "excel.application") Set objWorkbook = objExcel.Workbooks.Add objWorkbook.SaveAs Filename Err.Number = 0 On Error GoTo Err_Handler Else Set objWorkbook = objExcel.Workbooks(0) End If
'Make it visible. objExcel.Visible = True
'Turn off the alerts, otherwise a user will have to confirm actions. objExcel.DisplayAlerts = False
'See if the worksheet exist based on the queryname. On Error Resume Next Set objWorksheet = objWorkbook.Worksheets(Qry) If Err.Number > 0 Then Set objWorksheet = objWorkbook.Worksheets.Add objWorksheet.Name = Qry End If Err.Clear
objWorkbook.Sheets(Qry).Range("A5").CopyFromRecordset rs
QryExcel = True Quit_Handler: 'Turn back on alerts if you would like user to be notified to save on exit. ' objExcel.DisplayAlerts = True 'Free up memory to help squash memory leaks. Set objExcel = Nothing Set objWorksheet = Nothing Set objWorkbook = Nothing Exit Function
Err_Handler: MsgBox Err.Description, vbInformation 'Err.Number = 0 Resume Quit_Handler End Function
|
|
Answer : Using CopyFromRecordset with recordset yields a blank worksheet. Urgent!
|
|
ok, try this for the syntax to renaming the worksheet
'Here is your line that adds the worksheet Set objWorksheet = objWorkbook.Worksheets.Add
'Now sheet gets added last? If so, rename last sheet to Qry objWorkbook.Sheets(objWorkbook.Sheets.Count).name = Qry
|
|
|
|