UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Exporting From Query Retaining Table Field Captions, Access 2016    
 
   
SemiAuto40
post Apr 22 2019, 12:03 PM
Post#1



Posts: 692
Joined: 3-April 12
From: L.A. (lower Alabama)


I've seen some VBA code (DevHut) which exports to Excel from an access query. I've tried it, but the one thing it does not do is include the "caption" which is in the base data table... the caption of each field name. The code is clean and clever but for me I need the captions of each field and not the actual field names themselves to be the top row of the Excel data. There may be an easy fix but I have not figured it out yet.

Thanks.
Go to the top of the page
 
ADezii
post Apr 22 2019, 12:19 PM
Post#2



Posts: 2,368
Joined: 4-February 07
From: USA, Florida, Delray Beach


How about posting the actual Code?
Go to the top of the page
 
SemiAuto40
post Apr 22 2019, 02:03 PM
Post#3



Posts: 692
Joined: 3-April 12
From: L.A. (lower Alabama)


CODE
'---------------------------------------------------------------------------------------
' Procedure : Export2XLS
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Export recordset to Excel
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sQuery    : Name of the table, or SQL Statement to be used to export the records
'             to Excel
'
' Usage:
' ~~~~~~
' Export2XLS "qryCustomers"
' Call Export2XLS("qryCustomers")
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' ********************************************************************************
******
' 1         2012-Apr-18                 Initial Release
' 2         2015-May-01                 Header Clarifications
'---------------------------------------------------------------------------------------
Function Export2XLS(strQuery As String)
    Dim oExcel          As Object
    Dim oExcelWrkBk     As Object
    Dim oExcelWrSht     As Object
    Dim bExcelOpened    As Boolean
    Dim IsFormOpen      As Boolean
    Dim db              As DAO.Database
    Dim rs              As DAO.Recordset
    Dim qdf             As DAO.QueryDef
    Dim iCols           As Integer
    
    Const xlCenter = -4108

    'Start Excel
    On Error Resume Next
    
    Set oExcel = GetObject(, "Excel.Application")    'Bind to existing instance of Excel

    If Err.Number <> 0 Then    'Could not get instance of Excel, so create a new one
        Err.Clear
        On Error GoTo Error_Handler
        Set oExcel = CreateObject("Excel.Application")
        bExcelOpened = False
    Else    'Excel was already running
        bExcelOpened = True
    End If
    On Error GoTo Error_Handler
    oExcel.ScreenUpdating = False
    oExcel.Visible = False   'Keep Excel hidden until we are done with our manipulation
    Set oExcelWrkBk = oExcel.Workbooks.Add()    'Start a new workbook
    Set oExcelWrSht = oExcelWrkBk.Sheets(1)
    Set db = CurrentDb()
    
    ' Open the form to collect the parameters.
    DoCmd.OpenForm "Batch Sheet Query", , , , , acHidden
    
    ' OK was pressed, so create the recordset.
'    If IsFormOpen("Batch Sheet Query") Then
        
    ' Satisfy the three parameters before attempting to create a recordset.
    Set qdf = db.QueryDefs(strQuery)
        
    qdf("Forms!Batch Sheet Query!StartDate") = Forms![Batch Sheet Query]![startDate]
    qdf("Forms!Batch Sheet Query!EndDate") = Forms![Batch Sheet Query]![endDate]
        
    ' Attempt to create the recordset.
    Set rs = qdf.OpenRecordset()
    rs.MoveLast
    rs.MoveFirst
    
    With rs
        If .RecordCount <> 0 Then
            'Build our Header
            For iCols = 0 To rs.Fields.Count - 1
                oExcelWrSht.Cells(1, iCols + 1).Value = rs.Fields(iCols).Name
            Next
            With oExcelWrSht.Range(oExcelWrSht.Cells(1, 1), _
                                   oExcelWrSht.Cells(1, rs.Fields.Count))
                .Font.Bold = True
                .Font.ColorIndex = 2
                .Interior.ColorIndex = 1
                .HorizontalAlignment = xlCenter
            End With
            'Copy the data from our query into Excel
            oExcelWrSht.Range("A2").CopyFromRecordset rs
            oExcelWrSht.Range(oExcelWrSht.Cells(1, 1), _
                              oExcelWrSht.Cells(1, rs.Fields.Count)).Columns.AutoFit    'Resize our Columns based on the headings

            oExcelWrSht.Range("A1").Select  'Return to the top of the page
        Else
            MsgBox "There are no records returned by the specified queries/SQL statement.", vbCritical + vbOKOnly, "No data to generate an Excel spreadsheet with"
            GoTo Error_Handler_Exit
        End If
    End With
            
    qdf.Close
    rs.Close
Go to the top of the page
 
ADezii
post Apr 22 2019, 02:41 PM
Post#4



Posts: 2,368
Joined: 4-February 07
From: USA, Florida, Delray Beach


  1. Since the Fields in the Recordset seem to Inherit the Caption Properties of the Fields in the Query, I modified the manner in which the Header is built.
  2. Each Field in the Recordset is checked, if it has a Caption then the Caption is written to the Header, if not the Field Name is written to the Header.
  3. Obviously, I omitted a lot of Code that was not really relevant to the question at hand.
  4. I limited the Code changes to the 'Build our Header Section.
  5. Be advised that this is AIR CODE and has not actually been tested since I am at work and do not have access to Access (no pun intended).
  6. Give it a shot, see how it works, and let me know.
  7. Code Definition:
    CODE
    With rs
      If .RecordCount <> 0 Then
        'Build our Header
        For iCols = 0 To rs.Fields.Count - 1
          If IsNull(.Fields(iCols).Properties("Caption")) Then
            oExcelWrSht.Cells(1, iCols + 1).Value = .Fields(iCols).Name
          Else
            oExcelWrSht.Cells(1, iCols + 1).Value = .Fields(iCols).Properties("Caption")
          End If
        Next
        
        With oExcelWrSht.Range(oExcelWrSht.Cells(1, 1), _
                               oExcelWrSht.Cells(1, rs.Fields.Count))
          .Font.Bold = True
          .Font.ColorIndex = 2
          .Interior.ColorIndex = 1
          .HorizontalAlignment = xlCenter
        End With
        'Copy the data from our query into Excel
        oExcelWrSht.Range("A2").CopyFromRecordset rs
        oExcelWrSht.Range(oExcelWrSht.Cells(1, 1), _
                          oExcelWrSht.Cells(1, rs.Fields.Count)).Columns.AutoFit
        oExcelWrSht.Range("A1").Select  'Return to the top of the page
      Else
        MsgBox "There are no records returned by the specified queries/SQL statement.", vbCritical + -vbOKOnly, "No data to generate an Excel spreadsheet with"
        GoTo Error_Handler_Exit
      End If
    End With
  8. Good Luck with your Project.

This post has been edited by ADezii: Apr 22 2019, 02:42 PM
Go to the top of the page
 
SemiAuto40
post Apr 22 2019, 04:16 PM
Post#5



Posts: 692
Joined: 3-April 12
From: L.A. (lower Alabama)


Getting an error of "property not found" at the .Properties("Caption")
What would be the cause of this error. The code looks sound to me.
Go to the top of the page
 
ADezii
post Apr 22 2019, 05:52 PM
Post#6



Posts: 2,368
Joined: 4-February 07
From: USA, Florida, Delray Beach


This was a little tricky, but try this (Code intentionally omitted):
CODE
'Build our Header
For iCols = 0 To rs.Fields.Count - 1
   If HasProperty(.Fields(iCols), "Caption") Then
    oExcelWrSht.Cells(1, iCols + 1).Value = .Fields(iCols).Properties("Caption")
  Else
    oExcelWrSht.Cells(1, iCols + 1).Value = .Fields(iCols).Name
  End If
Next

CODE
Public Function HasProperty(obj As Object, strPropName As String) As Boolean
'Purpose:   Return true if the Object has the Property.
Dim varDummy As Variant
    
On Error Resume Next

varDummy = obj.Properties(strPropName)

HasProperty = (Err.Number = 0)
End Function
Go to the top of the page
 
SemiAuto40
post Apr 23 2019, 10:18 AM
Post#7



Posts: 692
Joined: 3-April 12
From: L.A. (lower Alabama)


CODE
With rs
  If .RecordCount <> 0 Then
    'Build our Header
    For iCols = 0 To rs.Fields.Count - 1
      If IsNull(.Fields(iCols).Properties("Caption")) Then
        oExcelWrSht.Cells(1, iCols + 1).Value = .Fields(iCols).Name
      Else
        oExcelWrSht.Cells(1, iCols + 1).Value = .Fields(iCols).Properties("Caption")
      End If
    Next
    
    With oExcelWrSht.Range(oExcelWrSht.Cells(1, 1), _
                           oExcelWrSht.Cells(1, rs.Fields.Count))
      .Font.Bold = True
      .Font.ColorIndex = 2
      .Interior.ColorIndex = 1
      .HorizontalAlignment = xlCenter
    End With
    'Copy the data from our query into Excel
    oExcelWrSht.Range("A2").CopyFromRecordset rs
    oExcelWrSht.Range(oExcelWrSht.Cells(1, 1), _
                      oExcelWrSht.Cells(1, rs.Fields.Count)).Columns.AutoFit
    oExcelWrSht.Range("A1").Select  'Return to the top of the page
  Else
    MsgBox "There are no records returned by the specified queries/SQL statement.", vbCritical + -vbOKOnly, "No data to generate an Excel spreadsheet with"
    GoTo Error_Handler_Exit
  End If
End With


Your first code above works........ when applied to an access table which DOES NOT HAVE input masks as a part of its structure.
You first code DOES NOT WORK...... when applied to the SAME access table WITH THE INPUT MASKS as a part of a few of the fields.

Since the masks serve some useful purpose, if there were a way to remove the input masks from the recordset I could use the code above.

Thank you for your effort thus far hat_tip.gif
Go to the top of the page
 
ADezii
post Apr 23 2019, 10:31 AM
Post#8



Posts: 2,368
Joined: 4-February 07
From: USA, Florida, Delray Beach


QUOTE
if there were a way to remove the input masks from the recordset I could use the code above

Not really sure if that can be done, but will look into it for you.
Go to the top of the page
 
ADezii
post Apr 23 2019, 11:59 AM
Post#9



Posts: 2,368
Joined: 4-February 07
From: USA, Florida, Delray Beach


QUOTE
if there were a way to remove the input masks from the recordset I could use the code above.

As far as I know, there is not, at least within the Recordset.

I have no idea why the Input Masks would have any effect in the current Code context. You can DELETE the Input Masks prior to the Code Processing if you know ahead of time what Fields and in what Tables they pertain to. Apparently, you cannot modify/change the Input Mask within the context of a Recordset Loop. Here is the Code to DELETE Input Masks for those Fields that have them:
CODE
Public Sub DeleteALLInputMasks_2(strTableName As String, strFldName As String)
On Error Resume Next
CurrentDb.TableDefs(strTableName).Fields(strFldName).Properties.Delete "InputMask"
End Sub

CODE
Call DeleteALLInputMasks_2("tblTest", "[Phone]")
Call DeleteALLInputMasks_2("tblTest", "[TDate]")
Call DeleteALLInputMasks_2("tblTest", "[Test Field]")

This post has been edited by ADezii: Apr 23 2019, 12:01 PM
Go to the top of the page
 
SemiAuto40
post Apr 23 2019, 01:45 PM
Post#10



Posts: 692
Joined: 3-April 12
From: L.A. (lower Alabama)


I find it very hard to believe that no one uses input masks in their tables - and then has any cause to Export data from that table into an Excel document! pullhair.gif
Are the table input masks not good practice or commonly used?
Go to the top of the page
 
tina t
post Apr 23 2019, 03:26 PM
Post#11



Posts: 5,955
Joined: 11-November 10
From: SoCal, USA


QUOTE
Are the table input masks not good practice or commonly used?

well, i use them frequently, at the form level.

can't speak for anyone else, but personally i try not to put anything in a table that's not needed at the table level. so i don't set input masks at the table level, because i don't do data entry in tables, or allow my users to.

hth
tina

--------------------
"the wheel never stops turning"
Go to the top of the page
 
SemiAuto40
post Apr 23 2019, 03:37 PM
Post#12



Posts: 692
Joined: 3-April 12
From: L.A. (lower Alabama)


Sounds like a very good practice and practical as well.

Thank you.
Go to the top of the page
 
tina t
post Apr 23 2019, 09:30 PM
Post#13



Posts: 5,955
Joined: 11-November 10
From: SoCal, USA


well, you're welcome, of course, but i know it doesn't help you with the practical problem you're facing at the moment. sorry i have no help to offer with that, hon. tina

--------------------
"the wheel never stops turning"
Go to the top of the page
 
gemmathehusky
post Apr 26 2019, 04:57 AM
Post#14


UtterAccess VIP
Posts: 4,668
Joined: 5-June 07
From: UK


Generally I hate input masks, other than password.
I also hate captions. I can't imagine any reason to use a caption.

It may well be that office automation ignores captions, and exports the field names.
What happens if you specifically alias the columns in this particular query. A bit of a pain, but it's only a one time operation.


--------------------
Dave (Male)

(Gemma was my dog)
Go to the top of the page
 
tina t
post Apr 26 2019, 01:22 PM
Post#15



Posts: 5,955
Joined: 11-November 10
From: SoCal, USA


QUOTE
I also hate captions. I can't imagine any reason to use a caption.

i use captions all the time, because my fieldnames are Access-friendly and programmer-friendly, but not user-friendly. i just don't set captions at the table level. IIRC, the forms wizard will apply table-level captions to the control labels' caption property, when building a form. and maybe apply table-level captions ditto if you drag fieldnames from the Fields list into a form, in Design view. but it's never been worth the small savings in time, to me.

hth
tina

--------------------
"the wheel never stops turning"
Go to the top of the page
 
gemmathehusky
post May 9 2019, 08:40 AM
Post#16


UtterAccess VIP
Posts: 4,668
Joined: 5-June 07
From: UK


@tina t

that's what I meant. I don't like setting a caption at the table level.

--------------------
Dave (Male)

(Gemma was my dog)
Go to the top of the page
 


Custom Search


RSSSearch   Top   Lo-Fi    15th June 2019 - 06:29 PM