Software‎ > ‎Code‎ > ‎

Convert tab-separated text file to CSV

Tab-separated (tab-delimited) text files are convenient for many purposes, but one disadvantage is that if you want to import or link them to Access under program control you have to provide either an import specification or a schema.ini file. By contrast, most CSV - comma-separated - files can be linked or imported without needing a specification (because this is the default type assumed by DoCmd.TransferText).

So here's a VBA function that converts a tab-separated file to CSV.

Public Function ConvertTabSeparatedToCSV( _
ByVal FileSpec As String, _
Optional ByVal BackupExtension As String = "", _
Optional Separator As String = ",", _
Optional UnixQuoting As Boolean = False) As Long

'Converts a tab-separated (tab-delimited) text file to
'CSV (comma-separated). Returns 0 if successful,
'VBA error code otherwise.
'By John Nurick, Feb 2007.

' FileSpec: Path and name of file to convert

' BackupExtension: If supplied, original file will be left
' as a backup with this extension (e.g. "bak")

' Separator: By default this is a comma. In countries where
' a comma is used for the decimal point, the
' field separator is usually a semicolon

' UnixQuoting: If a field value contains a quote mark ",
' it needs special handling or it will be confused
' with the quote marks used to enclose values
' that contain separators. In Windows, quotes need
' to be ""doubled""; in some other systems they need
' to be \"escaped\" with a backslash. In that case,
' set UnixQuoting:=True

Const QUOTE = """"

Dim fso As Object 'Scripting.FileSystemObject
Dim fIn As Object 'Scripting.TextStream
Dim fOut As Object 'Scripting.TextStream
Dim fFile As Object 'Scripting.File
Dim strFolder As String
Dim strNewFile As String
Dim strBakFile As String
Dim strQuote As String
Dim strLine As String
Dim arFields As Variant
Dim j As Long

On Error GoTo Err_ConvertTabSeparatedToCSV

Set fso = CreateObject("Scripting.FileSystemObject")

With fso
'Handle relative path in Filespec
FileSpec = .GetAbsolutePathName(FileSpec)
strFolder = .GetParentFolderName(FileSpec)
strNewFile = .BuildPath(strFolder, fso.GetTempName)
'Open files
Set fIn = .OpenTextFile(FileSpec, ForReading)
Set fOut = .CreateTextFile(strNewFile, True)

'Process lines in file
Do While Not fIn.AtEndOfStream
strLine = fIn.ReadLine
'Escape any quotes
If UnixQuoting Then
strQuote = "\" & QUOTE
strQuote = QUOTE & QUOTE
End If
strLine = Replace(strLine, QUOTE, strQuote)

'if a value contains Separator or ", qualify it with quotes
arFields = Split(strLine, vbTab)
For j = 0 To UBound(arFields)
If InStr(arFields(j), Separator) _
Or InStr(arFields(j), QUOTE) Then
arFields(j) = QUOTE & arFields(j) & QUOTE
End If
fOut.WriteLine Join(arFields, Separator)


'Rename or delete old file
If Len(BackupExtension) > 0 Then
strBakFile = .GetBaseName(FileSpec) _
& IIf(Left(BackupExtension, 1) <> ".", ".", "") _
& BackupExtension
If .FileExists(.BuildPath(strFolder, strBakFile)) Then
.DeleteFile .BuildPath(strFolder, strBakFile), True
End If
Set fFile = .GetFile(FileSpec)
fFile.Name = strBakFile
Set fFile = Nothing
.DeleteFile FileSpec, True
End If

'Rename new file
Set fFile = .GetFile(strNewFile)
fFile.Name = .GetFileName(FileSpec)
Set fFile = Nothing
Set fso = Nothing

End With
'normal exit
ConvertTabSeparatedToCSV = 0
Exit Function
ConvertTabSeparatedToCSV = Err.Number

End Function