Query results horizontally for single line export to Excel (1 Viewer)

TB11

Member
Local time
Yesterday, 18:24
Joined
Jul 7, 2020
Messages
54
Hi.

I need to have the query render the results vertically, into a single row for exporting to Excel for mail merge. I've read that I need multiple crosstab queries to do this, but I am not really sure where/how to start.

Table: ID, Team, Color, Sport

Wish list results: TeamA, TeamAColor, TeamASport, TeamB, TeamBColor, TeamBSport, TeamC, TeamCColor, TeamC Sport, etc.

Or, do I need to export the query to Excel, then do formulas in each Excel column to copy value from column A across row 1?

Any thoughts?

Thanks.
 

Minty

AWF VIP
Local time
Today, 00:24
Joined
Jul 26, 2013
Messages
8,900
You won't easily get that result layout into an Access query.
It's probably easier to Pivot/Transpose it in Excel, if you fancied a bit of a challenge you could probably automate the process completely from Access.
 

Pat Hartman

Super Moderator
Staff member
Local time
Yesterday, 19:24
Joined
Feb 19, 2002
Messages
33,677
You can automate excel to fill in the columns or you can create a .csv file. I would probably use Write to export a .csv file which Excel can read or you can automate excel to open the .csv file and save as an .xlxs file.

Build the export using VBA. Use a DAO loop to read through the recordset, and if you are building a .cav, then concatenate each field separated with a comma and enclosed in quotes.
 

MajP

You've got your good things, and you've got mine.
Local time
Yesterday, 19:24
Joined
May 21, 2018
Messages
5,680
So I built the table
tblTest tblTest

IDTeamColorSport
1​
ARedFootball
2​
BBlueBaseball
3​
CGreenHockey
And this code
Code:
Public Sub ExportCSV()
  Const TableName = "tblTest"
  Const DQ = """"
  Dim ExportFile As String
  Dim rs As DAO.Recordset
  Dim strOut As String
  Dim Team As String
  Dim Color As String
  Dim Sport As String
  Dim FS As Object
  Dim Stream As Object
 
  Set FS = CreateObject("Scripting.FileSystemObject")
  Set rs = CurrentDb.OpenRecordset(TableName)
  ExportFile = CurrentProject.Path & "\Export" & Format(Date, "yyyymmdd") & ".csv"
  If Dir(ExportFile) <> "" Then
    Kill ExportFile
  End If
  Debug.Print ExportFile
  Set Stream = FS.CreateTextFile(ExportFile, False, True)
 
  Do While Not rs.EOF
    Team = DQ & "Team_" & rs!Team & DQ
    Color = DQ & rs!Color & DQ
    Sport = DQ & rs!Sport & DQ
    If strOut = "" Then
      strOut = Team & "," & Color & "," & Sport
    Else
      strOut = strOut & "," & Team & "," & Color & "," & Sport
    End If
    rs.MoveNext
    
  Loop
  Stream.write strOut
  Stream.Close
End Sub

Which creates the correct CSV file with output like
Code:
"Team_A","Red","Football","Team_B","Blue","Baseball","Team_C","Green","Hockey"

However when I open in Excel it does not create individual cells just one cell that looks like
Code:
Team_A,"Red","Football","Team_B","Blue","Baseball","Team_C","Green","Hockey"
with the " removed from the first word.

Anyone tell me what needs to get added or modified?
 

Sun_Force

Active member
Local time
Today, 09:24
Joined
Aug 29, 2020
Messages
349
Anyone tell me what needs to get added or modified?

@MajP
We have a professor here who enjoys teaching us strange behavior of different apps.
Once he showed us how to do something like this. It may give you a hint.

It's exactly what he did. (he did it in #C. You may be able to do the same in vba too.)
1- Export the result as :
Code:
Team_A	Red	Football	Team_B	Blue	Baseball	Team_C	Green	Hockey
That is not space. Those are Tabs between each of them.
2- Save the result as yourfilename.dat
3- open the .dat file with Excel. (you will receive a message if you trust the file. just press OK)

Edit:
I just did it in notepad and it worked. I separated the words with tab. Saved it as .dat and opened it in Excel.
 
Last edited:

MajP

You've got your good things, and you've got mine.
Local time
Yesterday, 19:24
Joined
May 21, 2018
Messages
5,680
Thanks. I replaced the , with a tab and it worked. Not sure why the comma does not.
Code:
Public Sub ExportCSV()
  Const TableName = "tblTest"
  Const DQ = """"
  Dim ExportFile As String
  Dim rs As DAO.Recordset
  Dim strOut As String
  Dim Team As String
  Dim Color As String
  Dim Sport As String
  Dim FS As Object
  Dim Stream As Object
 
  Set FS = CreateObject("Scripting.FileSystemObject")
  Set rs = CurrentDb.OpenRecordset(TableName)
  ExportFile = CurrentProject.Path & "\Export" & Format(Date, "yyyymmdd") & ".csv"
  If Dir(ExportFile) <> "" Then
    Kill ExportFile
  End If
  Debug.Print ExportFile
  Set Stream = FS.CreateTextFile(ExportFile, False, True)
 
  Do While Not rs.EOF
    Team = DQ & "Team_" & rs!Team & DQ
    Color = DQ & rs!Color & DQ
    Sport = DQ & rs!Sport & DQ
    If strOut = "" Then
      'strOut = Team & "," & Color & "," & Sport
      strOut = Team & Chr(9) & Color & Chr(9) & Sport
    Else
      'strOut = strOut & "," & Team & "," & Color & "," & Sport
      strOut = strOut & Chr(9) & Team & Chr(9) & Color & Chr(9) & Sport
    End If
    rs.MoveNext
    
  Loop
  Stream.write strOut
  Stream.Close
End Sub
 

Attachments

  • MakeCSV.accdb
    924 KB · Views: 141

isladogs

CID VIP
Local time
Today, 00:24
Joined
Jan 14, 2017
Messages
15,516
By default, at least in the UK, the separator for text files is a tab rather than a comma. (TSV rather than CSV in structure.)
When you double click the CSV file created, Excel opens and handles the layout automatically. In this case into a single cell.

However if you open the CSV file from Excel, you will get the text import wizard allowing you to edit how the file is handled
1627546266155.png

Alternatively export text files from Access as .txt so Excel automatically uses the import wizard
 

Attachments

  • 1627546048528.png
    1627546048528.png
    29.3 KB · Views: 125

MajP

You've got your good things, and you've got mine.
Local time
Yesterday, 19:24
Joined
May 21, 2018
Messages
5,680
Thanks. As pointed out in the other thread by changing
Set Stream = FS.CreateTextFile(ExportFile, False, True)
to
Set Stream = FS.CreateTextFile(ExportFile, False, False)
Changes the file encoding from Unicode to ASCII

It works with this change.
 

Auntiejack56

Registered User.
Local time
Today, 11:24
Joined
Aug 7, 2017
Messages
96
Just love arrays for this sort of thing ...

Code:
Function ExportTeamsToExcelForMerge()
    Dim dbs As DAO.Database, strSQL As String
    Dim xlApp As Object, xlWB As Object, xlWS As Object
    Dim n As Long, i As Long, nCol As Long
    Dim arrTeams
On Error GoTo Catch_Error
    
    Set dbs = CurrentDb()
    
    Set xlApp = CreateObject("Excel.Application")
    Set xlWB = xlApp.Workbooks.Add
    Set xlWS = xlWB.Worksheets.Add
    xlWS.Name = "Teams Merge"
    
    strSQL = "SELECT t.Team, t.Color, t.Sport FROM tblTeams AS t;"
    arrTeams = dbs.OpenRecordset(strSQL, dbOpenSnapshot).GetRows(999)
    
    For n = 0 To UBound(arrTeams, 2)
        For i = 0 To UBound(arrTeams, 1)
            nCol = nCol + 1
            xlWS.cells(1, nCol) = arrTeams(i, n)
        Next
    Next
    xlApp.Visible = True
Proc_Exit:
    Set dbs = Nothing
    Set xlWS = Nothing
    Set xlWB = Nothing
    Set xlApp = Nothing
    Exit Function
Catch_Error:
    MsgBox Err.Description & vbCrLf & "Cannot export the teams to Excel.", vbInformation, "Export failed"
    Resume Proc_Exit
    Resume
  
End Function
 

Users who are viewing this thread

Top Bottom