INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

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!

*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.

Jobs

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."
        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
 

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

My Archive

Resources

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