TransferText - Export Table to Text File and Include Column Names

[Guest]

Hello, thanks for helping me with this very annoying problem. I've searched
message boards and google for over an hour and have not found a solution for
this problem.

Using either a Macro or Visual Basic I need to export a table to tab
delimited text file having the first row of the text file be the column
names. I have everything working EXCEPT having the column names exported.

Here is my current VB Code:

DoCmd.TransferText acExportDelim, "kjmSpecs", "product_table_import",
"c:\mytable.txt", True

The "kjmSpecs" is my specification file that tells Access to export it as
Tab Delimited rather than CSV.

The "True" is supposed to mean to also export the column names.

For some reason the column names are never exported!

As a test I wrote similar code:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
"product_table_import", "c:\spreadsheet.xls", True, "A1: ZZ99999"

and that DID export the column names.

What is the problem? Does anybody have any idea why the column names will
not export into the text file?

Thanks for your help!

 

[JM]

Kevin,

I do not know why the transfertext doen noet work, but you could try
something like this.

James

Sub exportToTextFile()

Dim rst As DAO.Recordset
Dim db As DAO.Database
Dim fld As DAO.Field
Dim strDelimeter As String
Dim strText As String
Dim blnColumnHeaders As Boolean

Set db = CurrentDb

blnColumnHeaders = True
strDelimeter = Chr(9)

Set rst = db.OpenRecordset("select * from Query2")

Open "c:\temp\employees.txt" For Output As #1

If blnColumnHeaders = True Then
For Each fld In rst.Fields
strText = strText & fld.Name & strDelimeter
Next fld
strText = strText & vbNewLine
End If



Do While Not rst.EOF
For Each fld In rst.Fields
strText = strText & fld.Value & strDelimeter
Next
strText = strText & vbNewLine

rst.MoveNext
Loop

Print #1, strText
Close #1

End Sub

 

[Guest]

That works almost perfect!

That code adds an extra tab after the last field.. giving me one tab too
many. Is there a way to tweak it so that it won't add a tab after the last
field? Thanks for the help!

Kevin

 

[JM]

Try this

Sub exportToTextFile()

Dim rst As DAO.Recordset
Dim db As DAO.Database
Dim fld As DAO.Field
Dim strDelimeter As String
Dim strText As String
Dim blnColumnHeaders As Boolean

Set db = CurrentDb

blnColumnHeaders = True
strDelimeter = Chr(9)

Set rst = db.OpenRecordset("select * from Query2")

Open "c:\temp\employees.txt" For Output As #1

If blnColumnHeaders = True Then
For Each fld In rst.Fields
strText = strText & fld.Name & strDelimeter
Next fld

'get rid of the last delimeter
strText = Left(strText, Len(strText) - Len(strDelimeter))

strText = strText & vbNewLine
End If



Do While Not rst.EOF
For Each fld In rst.Fields
strText = strText & fld.Value & strDelimeter
Next

'get rid of the last delimeter
strText = Left(strText, Len(strText) - Len(strDelimeter))

strText = strText & vbNewLine

rst.MoveNext
Loop

Print #1, strText
Close #1

End Sub

 

[Guest]

ALMOST.. thank you so much by the way...

That works perfect except at the very end of the file there is an extra
blank line added. Do you know how to prevent that from happening?

By the way, if anybody else uses this helpful code, make sure to check the
"Microsoft DAO 3.6 Object Libarary" in the VBA Tools, References menu.

 

[JM]

Kevin,

you can remove the last line by adding the following statement just
before the print #1, .....

strText = Left(strText, Len(strText) - Len(vbNewLine))

It may not be the neatest code, but it works.

 

[Guest]

Thank you for your continuous help with this problem. Everything works 100%
right now! Here is the final code:

Private Sub cmdExportDB_Click()

Dim rst As DAO.Recordset
Dim db As DAO.Database
Dim fld As DAO.Field
Dim strDelimeter As String
Dim strText As String
Dim blnColumnHeaders As Boolean

Set db = CurrentDb

blnColumnHeaders = True
strDelimeter = Chr(9)

Set rst = db.OpenRecordset("select * from TableNameToBeExported")

Open "c:\FileToBeCreated.txt" For Output As #1

If blnColumnHeaders = True Then
For Each fld In rst.Fields
strText = strText & fld.Name & strDelimeter
Next fld

'get rid of the last delimeter
strText = Left(strText, Len(strText) - Len(strDelimeter))

strText = strText & vbNewLine
End If

Do While Not rst.EOF
For Each fld In rst.Fields
strText = strText & fld.Value & strDelimeter
Next

'get rid of the extra delimeter
strText = Left(strText, Len(strText) - Len(strDelimeter))

strText = strText & vbNewLine

rst.MoveNext
Loop

'removes the extra line
strText = Left(strText, Len(strText) - Len(vbNewLine))
Print #1, strText
Close #1

End Sub