Export this Access query into Excel using a command button on an Acces

[CoolFactor]

I want to export this Access query into Excel using a command button on an Access form in the following way I describe below.

Below you will find the simple query I am trying to export to Excel using a command in an Access Form.

RowID strFY AccountID CostElementWBS CostElementTitle
1 2008 1 7 Integrated Logistics
2 2008 1 7 Integrated Logistics

I want to export the 1st record of this table to excel workbook "Test 1," in the following way:

In Workheet "Sheet1," I want the data pertaining to field strFY to go to Cell "A1," and then I want the data pertaining to field AccountID to go to Cell "A2."

Then in Worksheet "Sheet2," I want the data pertaining to field CostElementWBS to go to Cell "B1," and then I want the data pertaining to field CostElementTitle to go to Cell "B2."

FOR THE SECOND RECORD IN THIS TABLE:

I want to export the 2nd record of this table to excel workbook "Test 2," in the following way:

In Workheet "Sheet1," I want the data pertaining to field strFY to go to Cell "A1," and then I want the data pertaining to field AccountID to go to Cell "A2."

Then in Worksheet "Sheet2," I want the data pertaining to field CostElementWBS to go to Cell "B1," and then I want the data pertaining to field CostElementTitle to go to Cell "B2."

Also do I make my form based on that query?

A step by step process would be much appreciated.

I have the following code as well which does export the records into an excel worksheet but not the way I would like it to be and maybe with some help we can make this work just right:

Option Compare Database
Option Explicit

Private Sub cmdauto_Click()
On Error GoTo err_Handler

MsgBox ExportRequest, vbInformation, "Finished"

exit_Here:
Exit Sub
err_Handler:
MsgBox Err.Description, vbCritical, "Error"
Resume exit_Here
End Sub


Public Function ExportRequest() As String
On Error GoTo err_Handler

' Excel object variables
Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet

Dim sTemplate As String
Dim sTempFile As String
Dim sOutput As String

Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim sSQL As String
Dim lRecords As Long
Dim iRow As Integer
Dim iCol As Integer
Dim iFld As Integer

Const cTabOne As Byte = 1
Const cTabTwo As Byte = 2
Const cStartRow As Byte = 3
Const cStartColumn As Byte = 1

DoCmd.Hourglass True

' set to break on all errors
Application.SetOption "Error Trapping", 0

' start with a clean file built from the template file
sTemplate = CurrentProject.Path & "\Test 1.xls"
sOutput = CurrentProject.Path & "\Test 2.xls"
If Dir(sOutput) <> "" Then Kill sOutput
FileCopy sTemplate, sOutput

' Create the Excel Applicaiton, Workbook and Worksheet and Database object
Set appExcel = Excel.Application
Set wbk = appExcel.Workbooks.Open(sOutput)
Set wks = appExcel.Worksheets(cTabOne)
Set wks = appExcel.Worksheets(cTabTwo)

sSQL = "select * from qry_12"
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)
If Not rst.BOF Then rst.MoveFirst

' For this template, the data must be placed on the 4th row, third column.
' (these values are set to constants for easy future modifications)
iCol = cStartColumn
iRow = cStartRow


Do Until rst.EOF
iFld = 0
lRecords = lRecords + 1
Me.Repaint

For iCol = cStartColumn To cStartColumn + (rst.Fields.Count - 1)
wks.Cells(iRow, iCol) = rst.Fields(iFld)

If InStr(1, rst.Fields(iFld).Name, "Date") > 0 Then
wks.Cells(iRow, iCol).NumberFormat = "mm/dd/yyyy"
End If

wks.Cells(iRow, iCol).WrapText = False
iFld = iFld + 1
Next

wks.Rows(iRow).EntireRow.AutoFit
iRow = iRow + 1
rst.MoveNext
Loop

ExportRequest = "Total of " & lRecords & " rows processed."

exit_Here:
' Cleanup all objects (resume next on errors)
On Error Resume Next
Set wks = Nothing
Set wbk = Nothing
Set appExcel = Nothing
Set rst = Nothing
Set dbs = Nothing
DoCmd.Hourglass False
Exit Function

err_Handler:
ExportRequest = Err.Description
Resume exit_Here

End Function

 

[JerryKlmns]

CoolFactor

I don't see you changing sheets for the different fields you mention! Nor do I see any changing of the workbook you mention for the second record been exported. And what happens to the 3rd record? Goes to a 3rd workbook?

FYI, there is a .CopyFromRecordset method of the Range object available since excel2000. And the date format should happen at the end of the loop. Interogate only once for all the rst.fields and then apply to entire columns.

And here comes the worst! Ghost excel, after your code finishes. Do use

appExcel.Quit
Set appExcel = Nothing

to close excel.exe properly and then destroy the object.

So, if you clarify the logic of what you want to do then we could modify the code.

 

[CoolFactor]

Jerry,

Thank you first of all for your response. After these 2 paragraphs you'll find that I modified the code. This code puts the 1st record's information where it's suppose to go but the 2nd record's information does not open a new workbook at to place this information in it. I know I said in my previous message that I wanted the 1st record to go into workbook "Test 1" and the 2nd record into workbook "Test 2." I changed that so that the 1st record will go into a new workbook and then 2nd second record will go into a new workbook as well and if their was a 3rd record it would go into a new workbook as well.

I'm trying to understand what you are suggesting but I just plain don't know where it fits in the code that I created. If it wouldn't be to much trouble could you take a look at my modified code and then help with placing what you are suggesting. I also get an error code "Subscript out of range," on this part of the code "With appExcel.Workbooks(rst!RowID)."

Let me know if we understand each other a little better or else I can explain myself better.


Option Compare Database
Option Explicit

Private Sub cmdauto_Click()
On Error GoTo err_Handler

MsgBox ExportRequest, vbInformation, "Finished"

exit_Here:
Exit Sub
err_Handler:
MsgBox Err.Description, vbCritical, "Error"
Resume exit_Here
End Sub


Public Function ExportRequest() As String
On Error GoTo err_Handler

' Excel object variables
Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet

Dim sTemplate As String
Dim sTempFile As String
Dim sOutput As String

Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim sSQL As String
Dim lRecords As Long
Dim iRow As Integer
Dim iCol As Integer
Dim iFld As Integer

Const cTabOne As Byte = 1
Const cTabTwo As Byte = 2
Const cStartRow As Byte = 3
Const cStartColumn As Byte = 1

DoCmd.Hourglass True

' set to break on all errors
Application.SetOption "Error Trapping", 0

' start with a clean file built from the template file
sTemplate = CurrentProject.Path & "\Test 1.xls"

' Create the Excel Applicaiton, Workbook and Worksheet and Database object
Set appExcel = New Excel.Application
appExcel.Visible = True
Set wbk = appExcel.Workbooks.Add(sTemplate)
Set wks = appExcel.Worksheets(cTabOne)

sSQL = "select * from qry_12"
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)
If Not rst.BOF Then rst.MoveFirst

' For this template, the data must be placed on the 4th row, third column.
' (these values are set to constants for easy future modifications)
iCol = cStartColumn
iRow = cStartRow

Do While rst!RowID >= 1 And rst!RowID <= 2
With appExcel.Workbooks(rst!RowID)
.Sheets(1).Range("A1") = rst!strFY
.Sheets(1).Range("A2") = rst!AccountID
.Sheets(2).Range("B1") = rst!CostElementWBS
End With
rst.MoveNext
Loop

ExportRequest = "Total of " & lRecords & " rows processed."

' My users appreciate when I resize the columns to fit the data.
wks.Cells.Select
wks.Cells.EntireColumn.AutoFit

' Set the focus back at the first cell
wks.Range("A1").Select

exit_Here:
' Cleanup all objects (resume next on errors)
On Error Resume Next
Set wks = Nothing
Set wbk = Nothing
Set appExcel = Nothing
Set rst = Nothing
Set dbs = Nothing
DoCmd.Hourglass False
Exit Function

err_Handler:
ExportRequest = Err.Description
Resume exit_Here

End Function


Thank you.

 

[JerryKlmns]

Let 's do it one step at the time

If you have 861 records you 'll end up with 861 workbooks. Each workbook contains 2 worksheets. Each record's fields strFY go to 1st sheet in A1 cell, AccountID go to 1st sheet in A2 cell and CostElementWBS go to 2nd sheet in B1 cell

That's the goal?

....
Set appExcel = New Excel.Application
appExcel.Visible = True
Set wbk = appExcel.Workbooks.Add(sTemplate)

sSQL = "select * from qry_12"
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)
If Not rst.BOF Then rst.MoveFirst

Do While not rst.EOF 
   With wbk 
      .Sheets(1).Range("A1") = rst.Fields("strFY")
      .Sheets(1).Range("A2") = rst.Fields("AccountID")
      .Sheets(1).Range("A1:A2").AutoFit
      .Sheets(2).Range("B1") = rst.Fields("CostElementWBS")
      .Sheets(1).Range("B1").AutoFit
      .Saveas rst.Fields("RowID ")
   End With
   rst.MoveNext
Loop
rst.Close

ExportRequest = "Total of " & lRecords & " rows processed."

exit_Here:
' Cleanup all objects (resume next on errors)
Set wbk = Nothing
appExcel.Quit
Set appExcel = Nothing
Set rst = Nothing
Set dbs = Nothing
DoCmd.Hourglass False
Exit Function

err_Handler:
ExportRequest = Err.Description
Resume exit_Here
....

Are we any closer now?

 

[CoolFactor]

Yes, what you just described is absolutely correct. That is exactly what I want to do.

I tried to simplify the issue with the example I gave.

In reality each Workbook contains 11 Worksheets but only the first 2 Worksheets of each Workbook will data populated into them. Each record's fields strFY go to 1st Worksheet in A1 cell, AccountID go to 1st Worksheet in A2 cell and CostElementWBS go to 2nd Worksheet in B1 cell. The same thing process occurs for the 2nd Record and if their were more records the same would occur for all the Records.

As you stated in your last message If you have 861 Records you'll end up with 861 Workbooks. I will have more than 2 Records but for simplicity sake I just wanted to do it for 2 Records just to see if it worked.

So my idea was than when each Record appears in it's own Workbook, the Code would produce a new name for each Workbook.

I tried the code you suggested but now I get the error message that says "Run time error '1004'.... AutoFit method of Range class failed." It thens points to this line of code " .Sheets(1).Range("A1:A2").AutoFit."

The code is still not populating Record # 2 in another Workbook.

I appreciate your help a lot.

 

[JerryKlmns]

Some amendments

.Sheets(1).Range("A1:A2").Columns.AutoFit
.Sheets(2).Range("B1") = rst.Fields("CostElementWBS")
.Sheets(2).Range("B1").Columns.AutoFit
.SaveAs CurrentProject.Path & "\" & rst.Fields("RowID ") &".xls"