Home > Excel VBA macros > How to import a text file

How to import a text file with Excel VBA

With Excel VBA you can export and import text files. This page shows how to import a semicolon delimited text file to a worksheet. Semicolon is used to separate cell content, and carriage return signals a new row.

I found most of the code on the Internet some years ago. Maybe it can be done in a smarter way, but it works fine for me.

The procedure "in control" of the operation is "Sub ImportDelimitedText()", while the function "ParseDelimitedString" and the procedure "UpdateCells" parse the text and insert it into the cells. See also how to write and export a text file with VBA.

Sub ImportDelimitedText()
'Imports the text separated by sSepChar in sSourceFile to
'Range(sTargetAddress). Overwrites any old data.
'Normally this procedure would be called by another
'passing info about the text file's name and path, separator
'(sSepChar) and maybe where to insert the text - the cell
'adress (sTargetSddress).

Dim sDel As String * 1
Dim LineString As String
Dim sSourceFile As String
Dim sSepChar As String
Dim sTargetAddress As String
Dim rTargetCell As Range
Dim vTargetValues As Variant
Dim r As Long
Dim fLen As Long
Dim fn As Integer

On Error GoTo ErrorHandle

'Text file and path
sSourceFile = "C:\filtest.txt"

'Separator (delimiter)
sSepChar = ";"

'Start cell for writing data
sTargetAddress = "A1"

'sSourceFile doesn't exist
If Len(Dir(sSourceFile)) = 0 Then Exit Sub

'Identifies the delimiter
If UCase(sSepChar) = "TAB" Or UCase(sSepChar) = "T" Then
   sDel = Chr(9)
Else
   sDel = Left(sSepChar, 1)
End If

'Import data
Worksheets(1).Activate

'Sets the range for the start cell
Set rTargetCell = Range(sTargetAddress).Cells(1, 1)

'Deletes any old data
rTargetCell.CurrentRegion.Clear

On Error GoTo BeforeExit

'Gets a free file number from the operating system
fn = FreeFile

'Opens the file for input
Open sSourceFile For Input As #fn
On Error GoTo 0
fLen = LOF(fn)
r = 0
While Not EOF(fn)
   Line Input #fn, LineString
   'Calls the function that parses the text.
   vTargetValues = ParseDelimitedString(LineString, sSepChar)
   'Writes to cells
   UpdateCells rTargetCell.Offset(r, 0), vTargetValues
   r = r + 1
Wend

'Closes the text file
Close #fn

BeforeExit:
Set rTargetCell = Nothing

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Error in ImportDelimitedText."
Resume BeforeExit
End Sub

The function below parses ("reads") the text.

Function ParseDelimitedString(InputString As String, _
sDel As String) As Variant
'Returns a variant array with every element in
'InputString separated by sDel.

Dim i As Integer, iCount As Integer
Dim sString As String, sChar As String * 1
Dim ResultArray() As Variant

On Error GoTo ErrorHandle

sString = ""
iCount = 0
For i = 1 To Len(InputString)
   sChar = Mid$(InputString, i, 1)
   If sChar = sDel Then
   iCount = iCount + 1
      ReDim Preserve ResultArray(1 To iCount)
      ResultArray(iCount) = sString
      sString = ""
   Else
      sString = sString & sChar
   End If
Next i

iCount = iCount + 1
ReDim Preserve ResultArray(1 To iCount)
ResultArray(iCount) = sString
ParseDelimitedString = ResultArray

Exit Function
ErrorHandle:
MsgBox Err.Description & " Error in function ParseDelimitedString."
End Function

The following procedure writes the text to cells in the worksheet.

Sub UpdateCells(rTargetRange As Range, vTargetValues As Variant)
'Writes the content in vTargetValues
'to the active sheet starting in rTargetRange.
'Overwrites existing data.

Dim r As Long, c As Integer

On Error GoTo ErrorHandle

If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
r = 1
c = 1

On Error Resume Next

c = UBound(vTargetValues, 1)
r = UBound(vTargetValues, 2)
Range(rTargetRange.Cells(1, 1), rTargetRange.Cells(1, 1). _
Offset(r - 1, c - 1)).Formula = vTargetValues

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Error in procedure UpdateCells."
End Sub

Related: