Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here


Microsoft: Access Forms FAQ

How to

Export data to an Excel form by NXMold
Posted: 24 Apr 09

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."
        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
        oExcel.Visible = True
    End If
    If xlsAction = "SaveOnly" Then
    End If
    If xlsAction = "EditOnly" Then
        oExcel.Visible = True
    End If
    If xlsAction = "PrintOnly" Then
        oExcel.Visible = True
        oBook.Close (False) 'do not save
    End If
    DoCmd.Hourglass False

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

Back to Microsoft: Access Forms FAQ Index
Back to Microsoft: Access Forms Forum

My Archive

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close