Export data to an Excel form

In order to export data from access to multiple excel forms I created this function. To use it follow these steps.

1) Edit your existing excel file, in the cells where you want data injected type [accessfieldname] in brackets.

2) Make an access form where ControlSource equals the text in your excel file. If using an unbound control, ControlName must match the text in the excel file.

3) Put a button on your form with code to call the function, such as:
ExportXLS "\\netpath\folder\file.xlt", "PrintOnly", 1, Me
This button could also copy and rename the file to a job folder or temporary folder first, then save after exporting data.

4) Paste the code below into the general module to create a function named ExportXLS

What happens is that this code searches the specified file, column A thru Z, row 1 thru 100 (this could be modified) and when a cell begins with "[" it compares the cell value to ControlSource, if the control is unbound it compares with ControlName instead. If a match is found, the cell value is overwritten with the Control Value.

At the end of the function, four actions have been defined. SaveEdit, SaveOnly, EditOnly, and PrintOnly so that you can define the appropriate action case by case.

** ** **

Function ExportXLS(xlsFile, xlsAction As String, xlsSheet As Integer, BaseForm As Form)
On Error GoTo Err
Dim fso

Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(xlsFile) = False Then
MsgBox ("File not found" & vbCrLf & xlsFile)
Set fso = Nothing
Exit Function
End If

Dim oExcel, oBook, oSheet As Object
Dim Numsheets As Integer

DoCmd.Hourglass True

'Open excel, go to sheet
Set oExcel = CreateObject("Excel.Application")
Set oBook = oExcel.Workbooks.Open(xlsFile)
Numsheets = oBook.Sheets.Count
If [xlsSheet] > Numsheets Then
MsgBox "You specified sheet " & [xlsSheet] & ", but there are only " & [Numsheets] & " sheets in the workbook."
oExcel.Quit
Set fso = Nothing
Exit Function
End If
Set oSheet = oBook.Worksheets([xlsSheet])

'Search and inject data by matching cell values to field names (A1 through Z100)
Dim RowIdx, ColIdx As Integer
Dim CellIdx, SheetVar, CtlStr As String
Dim ctl As Control

For RowIdx = 1 To 100
For ColIdx = Asc("A") To Asc("Z")
CellIdx = Chr(ColIdx) & RowIdx
SheetVar = oSheet.range(CellIdx).Value
If Len(SheetVar) > 1 Then
For Each ctl In BaseForm.Controls
Select Case ctl.ControlType
Case acTextBox, acComboBox, acListBox, acOptionGroup, acCheckBox
'Find xls text by controlsource (table column name):
CtlStr = "[" & ctl.ControlSource & "]"
'Allow data to be passed via unbound controls using Control Name:
If Len(ctl.ControlSource) < 1 Then CtlStr = "[" & ctl.ControlName & "]"
If CtlStr = SheetVar Then oSheet.range(CellIdx).Value = ctl.Value
End Select
Next ctl
End If
Next ColIdx
Next RowIdx


If xlsAction = "SaveEdit" Then
oBook.Save
oExcel.Visible = True
End If
If xlsAction = "SaveOnly" Then
oBook.Save
oExcel.Quit
End If
If xlsAction = "EditOnly" Then
oExcel.Visible = True
End If
If xlsAction = "PrintOnly" Then
oExcel.Visible = True
oSheet.printpreview
oBook.Close (False) 'do not save
oExcel.Quit
End If

DoCmd.Hourglass False

Exit Function
Err:
oExcel.Quit
Set fso = Nothing
DoCmd.Hourglass False
MsgBox Err.Description
End Function