locked
Export query to CSV format with custom column headers RRS feed

  • Question

  • I've used Access before, but it's been several years since I did any development. I'm trying to export a query to CSV, but instead of putting the field names at the top of the columns, I want to assign different field labels. For example, the database might internally reference a field as "Brand", but I want the column header to show something  slightly (or sometimes wildly) different like "[C:Brand]". This CSV will be used to import into a 3rd party's non-Access database, and they have their own field labels. So far I've been stymied in trying to find a solution to this problem, but it seems like it should be a simple fix. I suppose I could pull the CSV into Excel and manually change the column headers, but I'm trying to automate this with as few manual steps as possible.
    Friday, March 31, 2017 9:31 PM

All replies

  • Hi,

    Try either using an Alias for each column or enter the description in the Caption property.

    Hope it helps...

    Friday, March 31, 2017 9:39 PM
  • You can use an alias as well in your query. Like:

    SELECT Brand AS [C-Brand] FROM T


    Groeten, Peter http://access.xps350.com/

    Saturday, April 1, 2017 9:43 AM
  • An alternative, if you don't want to amend the query definition, would be to write the data directly to a file by amending the following function:

    Function ExportToText(strQuery As String, _
                        strExportTo As String, _
                        strDelim As String, _
                        blnQuoteText As Boolean, _
                        Optional blnHasFieldNames As Boolean = True)
                        
    'Accepts:
    ' strQuery - Text - name of query to be exported
    ' strExportTo - Text- path to file to export to
    ' strDelim - Text - delimiter character(s) to separate fields
    ' blnQuoteText - Boolean - True to enclose text or memo data in quotes
    ' blnHasFieldNames - Boolean - (optional) - True (default) to export field names as first line

       Dim dbs As DAO.Database
       Dim rst As DAO.Recordset
       Dim qdf As DAO.QueryDef
       Dim prm As DAO.Parameter
       Dim Fld As DAO.Field
       Dim n As Integer
       Dim strPrintList As String
       Dim strQuote As String
       
       Set dbs = CurrentDb
       Set qdf = dbs.QueryDefs(strQuery)
       
       ' evaluate query's parameters, if any
       For Each prm In qdf.Parameters
           prm = Eval(prm.Name)
       Next prm
        
       Set rst = qdf.OpenRecordset
       
       If Dir(strExportTo) <> "" Then
           If MsgBox("Overwrite " & strExportTo & "?", vbQuestion + vbYesNo, "Export Query") = vbYes Then
               Kill strExportTo
           ElseIf MsgBox("Append rows to " & strExportTo & "?", vbQuestion + vbYesNo, "Export Query") = vbNo Then
               Exit Function
           End If
       End If
               
       With rst
           If Not (.BOF And .EOF) Then
               Open strExportTo For Append As #1
               
               If blnHasFieldNames Then
                    ' include column headings in text file
                    For n = 0 To qdf.Fields.Count - 1
                         strPrintList = strPrintList & strDelim & qdf.Fields(n).Name
                    Next n
                    ' remove leading delimiter
                    strPrintList = Mid$(strPrintList, Len(strDelim) + 1)
                    Print #1, strPrintList
                    strPrintList = ""
               End If
               
               Do While Not .EOF
                   For n = 0 To qdf.Fields.Count - 1
                       Set Fld = .Fields(n)
                       strQuote = IIf(blnQuoteText And (Fld.Type = dbText Or Fld.Type = dbMemo), """", "")
                       strPrintList = strPrintList & strDelim & strQuote & _
                       .Fields(n) & strQuote
                   Next n
                   ' remove leading delimiter
                   strPrintList = Mid$(strPrintList, Len(strDelim) + 1)
                   Print #1, strPrintList
                   strPrintList = ""
                   .MoveNext
               Loop
               Close #1
           End If
       End With

    Exit_Here:
       rst.Close
               
    End Function

    Normally the function would be called along these lines:

        ExportToText "qryBalances","Balances.txt",",",False,True

    but by amending the function as follows:

    Function ExportToText(strQuery As String, _
                        strExportTo As String, _
                        strDelim As String, _
                        blnQuoteText As Boolean, _
                        strColumnHeads As String, _
                        Optional blnHasFieldNames As Boolean = True)
                        
    'Accepts:
    ' strQuery - Text - name of query to be exported
    ' strExportTo - Text- path to file to export to
    ' strDelim - Text - delimiter character(s) to separate fields
    ' blnQuoteText - Boolean - True to enclose text or memo data in quotes
    ' strColumnHeads - Text - column headings as delimted string expression
    ' blnHasFieldNames - Boolean - (optional) - True (default) to export field names as first line

       Dim dbs As DAO.Database
       Dim rst As DAO.Recordset
       Dim qdf As DAO.QueryDef
       Dim prm As DAO.Parameter
       Dim Fld As DAO.Field
       Dim n As Integer
       Dim strPrintList As String
       Dim strQuote As String
       
       Set dbs = CurrentDb
       Set qdf = dbs.QueryDefs(strQuery)
       
       ' evaluate query's parameters, if any
       For Each prm In qdf.Parameters
           prm = Eval(prm.Name)
       Next prm
        
       Set rst = qdf.OpenRecordset
       
       If Dir(strExportTo) <> "" Then
           If MsgBox("Overwrite " & strExportTo & "?", vbQuestion + vbYesNo, "Export Query") = vbYes Then
               Kill strExportTo
           ElseIf MsgBox("Append rows to " & strExportTo & "?", vbQuestion + vbYesNo, "Export Query") = vbNo Then
               Exit Function
           End If
       End If
               
       With rst
           If Not (.BOF And .EOF) Then
               Open strExportTo For Append As #1
               
               If blnHasFieldNames Then
                    ' include column headings in text file
                    strPrintList = strColumnHeads
                    Print #1, strPrintList
                    strPrintList = ""
               End If
               
               Do While Not .EOF
                   For n = 0 To qdf.Fields.Count - 1
                       Set Fld = .Fields(n)
                       strQuote = IIf(blnQuoteText And (Fld.Type = dbText Or Fld.Type = dbMemo), """", "")
                       strPrintList = strPrintList & strDelim & strQuote & _
                       .Fields(n) & strQuote
                   Next n
                   ' remove leading delimiter
                   strPrintList = Mid$(strPrintList, Len(strDelim) + 1)
                   Print #1, strPrintList
                   strPrintList = ""
                   .MoveNext
               Loop
               Close #1
           End If
       End With

    Exit_Here:
       rst.Close
               
    End Function

    it could then be called along the following lines, passing the column headings in as a string expression:

        ExportToText "qryBalances","Balances.txt",",",False,"Account Name,Current Balance",True

    to head its two columns as Account Name and Current Balance.

    Ken Sheridan, Stafford, England

    Saturday, April 1, 2017 5:15 PM
  • Hi Imrazor,

    This can be an alternative approach that you can try.

    below is my query result in Access. you can see the Headers.

    I try to use code below and add customized header names.

    Sub demo()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Set db = CurrentDb
    Set rs = db.OpenRecordset("Query40", dbOpenSnapshot)
    Dim oApp As New Excel.Application
    Dim oBook As Excel.Workbook
    Dim oSheet As Excel.Worksheet
    Set oBook = oApp.Workbooks.Add
    Set oSheet = oBook.Worksheets(1)
    Dim i As Integer
    Dim iNumCols As Integer
    iNumCols = rs.Fields.count
    oSheet.Cells(1, 1).Value = "Demo Field 1"
    oSheet.Cells(1, 2).Value = "Demo Field 2"
    oSheet.Range("A2").CopyFromRecordset rs
    With oSheet.Range("a1").Resize(1, iNumCols)
    .Font.Bold = True
    .EntireColumn.AutoFit
    End With
    oApp.Visible = True
    oApp.UserControl = True
    rs.Close
    db.Close
    End Sub

    Output:

    you can try to modify the code and set the desire headers in Excel file.

    Regards

    Deepak


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Monday, April 3, 2017 5:25 AM
  • As long as you don't use any illegal column names or reserved words you should be able to export to a .csv rather easily:

    Dim db As DAO.Database
    Dim strSQL As String
    
    Set db = CurrentDb
    
    strSQL = "SELECT CustomerID as [C:ID], CompanyName As [C:FName], " & _
             "ContactName As [C:ConName], ContactTitle As [C:Title] " & _
             "INTO [Text;DATABASE=C:\Users\...\Documents\My Database\Text;HDR=Yes].[Customers.csv] FROM Customers"
             
    db.Execute strSQL
    
    db.Close
    Set db = Nothing


    Paul ~~~~ Microsoft MVP (Visual Basic)


    Monday, April 3, 2017 7:41 PM