Export form underlying query only visible fileds

I have unboud form  frmMain that has unboud subform frmSubMain. Form frmSubMain has as data source  a query.
Sub form frmSubMain is in datasheet view .

When the form frmSubMain is populated user first see all columns on form and he can export  values from the form to excel by exporting underlying form query . That works well and no problem.
However user has option to hide some columns and show just particular columns  based on  set of check boxes that user select (each check box fires a procedure that hide some columns on the form)
I want to export this query to excel but just visible columns of that form after user make selection and click on export button.
I need something to pull out visible fields from form underlying query I assume it should be done through form record set clone.
Option to create a new query with visible fields and export is not good as user has so many options- combinations which fields to see which fields to hide. So option with exporting just those selected visible fields(columns) would be solution.
Any idea how to export form underlying query but not all fields of query just those that are  visible on  this form.
TarasAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

John TsioumprisSoftware & Systems EngineerCommented:
Well if you match your controls to the recordset fields then you can check the visibility flag and thus export what you want
The code i use is this

Private Sub cmdExportToExcel_Click()
 On Error GoTo Err_cmdExcel_Click
    Dim rst As Object
    Const StartRow = 3
    Dim MaxRow As Integer
    Dim objXL As Object
    Dim objWkb As Object
    Dim objSht As Object
    Dim FieldNames() As String
    Dim X As Integer
    Dim strSQL As String
    Dim strFields As String
    Dim ctl As control
    Dim arrayCounter As Integer
    
    arrayCounter =0
    Me.Caption = "VIEWER"
    Set rst = Me.Recordset.Clone
    rst.MoveLast
    rst.MoveFirst
    MaxRow = rst.RecordCount
    
    ReDim FieldNames(rst.Fields.Count)
    For X = 0 To rst.Fields.Count - 1
       FieldNames(X + 1) = Nz(rst.Fields(X).NAME, "N.A")
    Next


Set objXL = CreateObject("Excel.Application")
    With objXL
        .Visible = True
        
        Set objWkb = .Workbooks.Add

        Set objSht = objWkb.Worksheets(1)
        objSht.NAME = "Name of Sheet"

        With objSht
                    .Range(.Cells(StartRow, 2), .Cells(StartRow + MaxRow, 2)) _
                    .CopyFromRecordset rst
                    For X = 0 To rst.Fields.Count
                    .Cells(1, 1 + X).Value = Nz(FieldNames(X), "N.A")
                    Next X
        End With
    End With

Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing


Set rst = Nothing

Exit_cmdExcel_Click:
    Exit Sub

Err_cmdExcel_Click:
    MsgBox Err.Description
    Resume Exit_cmdExcel_Click

End Sub

Open in new window

The critical point is here
   For X = 0 To rst.Fields.Count - 1
       FieldNames(X + 1) = Nz(rst.Fields(X).NAME, "N.A")
    Next

Open in new window

Here you need to change it to something like this
If HasMatch(rst.Fields(X).NAME) Then 
FieldNames(arrayCounter) = Nz(rst.Fields(X).NAME, "N.A")
arrayCounter = arrayCounter+1
end if

Open in new window


Public Function HasMatch(ControlName As String) As Boolean

Dim ctl As control
Dim blnMatch As Boolean
blnMatch = False
For Each ctl In Me.Controls
    If ctl.NAME = ControlName Then
 If ctl.Visible = True Then blnMatch = True
        Exit For
    End If
Next
HasMatch = blnMatch
End Function

Open in new window


And ofcourse you need changes to this part of code

With objSht
                    .Range(.Cells(StartRow, 2), .Cells(StartRow + MaxRow, 2)) _
                    .CopyFromRecordset rst
                    For X = lbound(FieldNames) To Ubound(FieldNames)
                    .Cells(1, 1 + X).Value = Nz(FieldNames(X), "N.A")
                    Next X
        End With

Open in new window



So FINALLY the code is
Private Sub cmdExportToExcel_Click()
 On Error GoTo Err_cmdExcel_Click
    Dim rst As Object
    Const StartRow = 3
    Dim MaxRow As Integer
    Dim objXL As Object
    Dim objWkb As Object
    Dim objSht As Object
    Dim FieldNames() As String
    Dim X As Integer
    Dim strSQL As String
    Dim strFields As String
    Dim ctl As Control
    Dim arrayCounter As Integer
    Dim rstF As DAO.Recordset
    Dim filtered As String
    arrayCounter = 0
    Me.Caption = "VIEWER"
    Set rst = Me.Recordset.Clone
    rst.MoveLast
    rst.MoveFirst
    MaxRow = rst.RecordCount
    
    ReDim FieldNames(rst.Fields.Count)
    For X = 0 To rst.Fields.Count - 1
        If HasMatch(rst.Fields(X).Name) Then
            FieldNames(arrayCounter) = Nz(rst.Fields(X).Name, "N.A")
            arrayCounter = arrayCounter + 1
            
        End If
        Next
        ReDim Preserve FieldNames(arrayCounter - 1)
        For X = LBound(FieldNames) To UBound(FieldNames)
            filtered = filtered & FieldNames(X) & ","
        Next
        filtered = Left(filtered, Len(filtered) - 1)
        Set rstF = CurrentDb.OpenRecordset("SELECT " & filtered & " FROM " & Me.RecordSource)
        Set objXL = CreateObject("Excel.Application")
        With objXL
            .Visible = True

            Set objWkb = .Workbooks.Add

            Set objSht = objWkb.Worksheets(1)
            objSht.Name = "Name of Sheet"

            With objSht
                .Range(.Cells(StartRow, 2), .Cells(StartRow + MaxRow, 2)) _
                        .CopyFromRecordset rstF
                For X = LBound(FieldNames) To UBound(FieldNames)
                    .Cells(1, 2 + X).Value = Nz(FieldNames(X), "N.A")
                Next X
            End With
        End With

        Set objSht = Nothing
        Set objWkb = Nothing
        Set objXL = Nothing


        Set rst = Nothing

Exit_cmdExcel_Click:
        Exit Sub

Err_cmdExcel_Click:
        MsgBox Err.Description
        Resume Exit_cmdExcel_Click
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
TarasAuthor Commented:
On you solution John I am getting MS Access error: Object variable or With block variable not set on line
:    Set rst = Me.Recordset.Clone
0
John TsioumprisSoftware & Systems EngineerCommented:
Check if declaring

[code]Dim rst as Dao.Recordset[/code]
resolves it
by the way the code should refer to the subform
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

TarasAuthor Commented:
It is the same still same error I see that my access 2013 do not recognized : Me.Recordset.Clone it recognized Me.RecordseClone without dot, I tried it still same error.
0
John TsioumprisSoftware & Systems EngineerCommented:
If you are running the code from the parent unbound form probably this is your problem...
You need to target the subform.
0
TarasAuthor Commented:
I tried with "Set rst  = Me.Recordset " just to see what will happen but getting "Nothing" on both side.
0
TarasAuthor Commented:
Yes,  it is running from parent sorry not seeing it
0
TarasAuthor Commented:
It is running well but showing all fields not just visible ones. How to show only visible columns - fields?? Did I miss something?
0
John TsioumprisSoftware & Systems EngineerCommented:
Modify the HasMatch to point also to the subform...
Check the output of filtered
0
TarasAuthor Commented:
Yes I modified HasMatch to sub form but still getting out all fields
0
John TsioumprisSoftware & Systems EngineerCommented:
better to upload your database to check what is wrong..
If you want to take another shot put a breakpoint here
If HasMatch(rst.Fields(X).Name) Then
            FieldNames(arrayCounter) = Nz(rst.Fields(X).Name, "N.A")
            arrayCounter = arrayCounter + 1            
        End If

Open in new window

and check what fields get entered in the array...
0
TarasAuthor Commented:
In my procedure for making fields on sub form not visible I have this:
Me.frmsubMain.Form.Controls("MyFieldName").ColumnHidden = True

Is that issue?
0
TarasAuthor Commented:
Thank you a lot John. It works perfect!!
0
John TsioumprisSoftware & Systems EngineerCommented:
glad you nailed it
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.