Ok, I was goofing around and came up with this and it works very well for me. However, if the number of rows on my next execution is less than the first one, I still have some left over rows. Can I select a block of data and delete it first? In excel if you hit shift ctl and down arrow you can highlight all cells. Can I do that with code? Anyway here is what I did...
'On Error GoTo ErrControl
DoCmd.SetWarnings False
Dim db As DAO.Database
Dim rs As DAO.Recordset 'records to be sent to the excel sheet
Dim qry As DAO.QueryDef 'used to define the query for the recordset we need to send to excel
Dim strSQL As String 'used to hold the fields for exporting to excel
Dim tabName As String 'the name of the tab in excel and the name of the query to export
Dim outputFile As String 'destination excel file
Dim monthlyCopy As String 'used to create a monthly copy of the file
Dim i As Integer 'counter used to determine a new line in excel
Set db = CurrentDb
'select fields for excel sheet
strSQL = "SELECT LNAME, FNAME, KAECSESID, [FROM], [TO], [PROCEDURE CODE], " _
& "[DIAGNOSIS CODE], [UNIT RATE], UNITS, EXTENSION, [AUTHORIZATION NUMBER] " _
& "FROM qryStandardBillingForm "
'destination
outputFile = "I:\DEPTDATA\BILLING FORM\BillingForm.xls"
'open the excel spreadsheet
Set xlsApp = CreateObject("Excel.Application")
xlsApp.Visible = True
xlsApp.UserControl = True
xlsApp.Workbooks.Open (outputFile)
'**************************************************************************************
'Create HOSP tab of the excel spread sheet
tabName = "HOSP"
Set qry = db.CreateQueryDef(tabName, strSQL _
& " WHERE PLCTYPE = 'HOSP' ORDER BY LNAME, FNAME")
'select the appropriate tab
Set xlsWSheet = xlsApp.Worksheets(tabName)
xlsWSheet.Activate
'get records for the tab from our newly made query
Set rs = db.OpenRecordset(tabName)
i = 10 'set counter to the line of our excel worksheet where I want it to start writing
Do Until rs.EOF
xlsApp.ActiveSheet.Range("A" & i).Value = rs("LNAME")
xlsApp.ActiveSheet.Range("B" & i).Value = rs("FNAME")
xlsApp.ActiveSheet.Range("C" & i).Value = rs("KAECSESID")
xlsApp.ActiveSheet.Range("D" & i).Value = rs("FROM")
xlsApp.ActiveSheet.Range("E" & i).Value = rs("TO")
xlsApp.ActiveSheet.Range("F" & i).Value = rs("PROCEDURE CODE")
xlsApp.ActiveSheet.Range("G" & i).Value = rs("DIAGNOSIS CODE")
xlsApp.ActiveSheet.Range("H" & i).Value = rs("UNIT RATE")
xlsApp.ActiveSheet.Range("I" & i).Value = rs("UNITS")
xlsApp.ActiveSheet.Range("J" & i).Value = rs("EXTENSION")
xlsApp.ActiveSheet.Range("K" & i).Value = rs("AUTHORIZATION NUMBER")
i = i + 1
rs.MoveNext
Loop
DoCmd.DeleteObject acQuery, tabName 'trash the temporary query
'**************************************************************************************
[EMAIL PROTECTED] wrote:
DoCmd.SetWarnings False
Dim db As DAO.Database
Dim rs As DAO.Recordset 'records to be sent to the excel sheet
Dim qry As DAO.QueryDef 'used to define the query for the recordset we need to send to excel
Dim strSQL As String 'used to hold the fields for exporting to excel
Dim tabName As String 'the name of the tab in excel and the name of the query to export
Dim outputFile As String 'destination excel file
Dim monthlyCopy As String 'used to create a monthly copy of the file
Dim i As Integer 'counter used to determine a new line in excel
Set db = CurrentDb
'select fields for excel sheet
strSQL = "SELECT LNAME, FNAME, KAECSESID, [FROM], [TO], [PROCEDURE CODE], " _
& "[DIAGNOSIS CODE], [UNIT RATE], UNITS, EXTENSION, [AUTHORIZATION NUMBER] " _
& "FROM qryStandardBillingForm "
'destination
outputFile = "I:\DEPTDATA\BILLING FORM\BillingForm.xls"
'open the excel spreadsheet
Set xlsApp = CreateObject("Excel.Application")
xlsApp.Visible = True
xlsApp.UserControl = True
xlsApp.Workbooks.Open (outputFile)
'**************************************************************************************
'Create HOSP tab of the excel spread sheet
tabName = "HOSP"
Set qry = db.CreateQueryDef(tabName, strSQL _
& " WHERE PLCTYPE = 'HOSP' ORDER BY LNAME, FNAME")
'select the appropriate tab
Set xlsWSheet = xlsApp.Worksheets(tabName)
xlsWSheet.Activate
'get records for the tab from our newly made query
Set rs = db.OpenRecordset(tabName)
i = 10 'set counter to the line of our excel worksheet where I want it to start writing
Do Until rs.EOF
xlsApp.ActiveSheet.Range("A" & i).Value = rs("LNAME")
xlsApp.ActiveSheet.Range("B" & i).Value = rs("FNAME")
xlsApp.ActiveSheet.Range("C" & i).Value = rs("KAECSESID")
xlsApp.ActiveSheet.Range("D" & i).Value = rs("FROM")
xlsApp.ActiveSheet.Range("E" & i).Value = rs("TO")
xlsApp.ActiveSheet.Range("F" & i).Value = rs("PROCEDURE CODE")
xlsApp.ActiveSheet.Range("G" & i).Value = rs("DIAGNOSIS CODE")
xlsApp.ActiveSheet.Range("H" & i).Value = rs("UNIT RATE")
xlsApp.ActiveSheet.Range("I" & i).Value = rs("UNITS")
xlsApp.ActiveSheet.Range("J" & i).Value = rs("EXTENSION")
xlsApp.ActiveSheet.Range("K" & i).Value = rs("AUTHORIZATION NUMBER")
i = i + 1
rs.MoveNext
Loop
DoCmd.DeleteObject acQuery, tabName 'trash the temporary query
'**************************************************************************************
[EMAIL PROTECTED] wrote:
Lonnie,
Be sure to set the DAO reference and the Excel reference. This works in
Access/Excel 2000. Please see comment about where to set column and row
reference. This code currently uses A1 as the starting point.
Good Luck
Hal
Function QrytoExcel(strFile As String, strSheet As String, strQuery As
String)
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim xlApp As Excel.Application
Dim xlWkb As Excel.Workbook
Dim xlSht As Excel.Worksheet
Dim strCurrentField As String
Dim varCurrentValue As Variant
Set db = CurrentDb()
Set rst = db.OpenRecordset(strQuery, dbOpenForwardOnly)
'OpenRecordsetOutput rstTemp
DoCmd.Hourglass True
If Assistant.Visible = True Then
With Assistant
.On = True
.Animation = msoAnimationCheckingSomething
.Visible = True
End With
End If
'**************************************************************************
'Open Spreadsheet
'**************************************************************************
' Start Excel Application
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
' Open File
xlApp.Workbooks.Open (strFile)
'************************************************************************************
'Clear Spreadsheet
'************************************************************************************
'
'Set Sheet = xlApp.activeworkbook.Sheets("ScheduleChangesDetail")
With xlApp
.Sheets(strSheet).Select
.Range("A2:F65536").Select 'Note range selected may need to be
changed
.Selection.ClearContents
End With
Set xlSht = xlApp.ActiveWorkbook.Sheets(strSheet)
j = 1
'Loop through the Microsoft Access field names and create
'the Microsoft Excel labels.
For i = 0 To rst.Fields.Count - 1
varCurrentValue = rst.Fields(i).Name
xlSht.Cells(j, i + 1).Value = varCurrentValue
Next i
j = 2
' Loop through the Microsoft Access records and copy the records
' to the Microsoft Excel spreadsheet.
Do Until rst.EOF
For i = 0 To rst.Fields.Count - 1
varCurrentValue = rst(i)
xlSht.Cells(j, i + 1).Value = varCurrentValue 'Make changes here to
control riw and column
Next i
rst.MoveNext
j = j + 1
Loop
xlApp.Workbooks.Application.Visible = False
xlApp.Application.ActiveWorkbook.Save
xlApp.Application.ActiveWorkbook.Close
xlApp.Quit
' Clear the object variable.
Set xlSht = Nothing
Set xlWkb = Nothing
Set xlApp = Nothing
DoCmd.Hourglass False
With Assistant
.On = True
.Animation = msoAnimationEmptyTrash
.Visible = True
End With
End Function
Hal McGee
Engineering Data Manager
Group Engineering - Process and Compliance
Seating Products Group
B/E Aerospace
Winston-Salem, NC
Lonnie Johnson
<[EMAIL PROTECTED]
om> To
Sent by: AccessDevelopers
AccessDevelopers@ <accessdevelopers@yahoogroups.com>
yahoogroups.com cc
Subject
08/02/2005 08:36 [AccessDevelopers] Writing to an
AM excel file
Please respond to
AccessDevelopers@
yahoogroups.com
I have a recordset that I would like to write as rows in an excel
spreadsheet.
I want to start on a certain line.
The columns are already predefined and match my recordset.
This will run each month so it will need to overwrite the prior month's
data.
What is the best way to go about this?
May God bless you beyond your imagination!
Lonnie Johnson
ProDev, Professional Development of MS Access Databases
Visit me at ==> http://www.prodev.us
Yahoo! Mail
Stay connected, organized, and protected. Take the tour
Please zip all files prior to uploading to Files section.
YAHOO! GROUPS LINKS
Visit your group "AccessDevelopers" on the web.
To unsubscribe from this group, send an email to:
[EMAIL PROTECTED]
Your use of Yahoo! Groups is subject to the Yahoo! Terms of Service.
May God bless you beyond your imagination!
Lonnie Johnson
ProDev, Professional Development of MS Access Databases
Visit me at ==> http://www.prodev.us
__________________________________________________
Do You Yahoo!?
Tired of spam? Yahoo! Mail has the best spam protection around
http://mail.yahoo.com
Please zip all files prior to uploading to Files section.
SPONSORED LINKS
| Microsoft access database | Free microsoft access database | Microsoft access developer |
| Microsoft access | Microsoft access database design | Microsoft access database training |
YAHOO! GROUPS LINKS
- Visit your group "AccessDevelopers" on the web.
- To unsubscribe from this group, send an email to:
[EMAIL PROTECTED]
- Your use of Yahoo! Groups is subject to the Yahoo! Terms of Service.
