I’m not much of an angler these days. In my younger days, I pulled my share out of the Skunk River and lakes around central Iowa and southern Minnesota. Sit back and I’ll tell you a tale about the one that got away….
Kidding – today’s post is the third in a series about Microsoft Scripting in VBA. In the first post I covered the FileSystemObjct (FSO). In the second post, I looked at Regular Expressions (RegExp).
Previous posts:
Today, I’ll look at the TextStream Object.
The TextStream Object
The TextStream Object enables you to read from and write to text files from Excel using VBA and the Microsoft Scripting Runtime Library (scrrun.dll)
- edit: I am going to use Late Binding in the sample snippets below. A discussion on Late / Early Binding is beyond the scope of this post. Please see these links for a detailed explanation of Late / Early Binding.
Public Variables
Because I am using Late Binding, I’ll declare some Public Constants for working with the TextStream Object
Public Const gclForReading As Long = 1 Public Const gclForWriting As Long = 2 Public Const gclForAppending As Long = 8 Public Const gclTristateUseDefault As Long = -2 Public Const gclTristateTrue As Long = -1 Public Const gclTristateFalse As Long = 0
Tristate specifies the format of the text file:
- TristateUseDefault = -2 ; Opens the file using the system default
- TristateTrue = -1 ; Opens the file as Unicode
- TristateFalse = 0 ; Opens the file as ASCII
I also would like to create a function to let users choose a file or a folder. To use the function I’ll create global constants using the MsoFileDialogType Enumeration:
Public Const gclmsoFileDialogFilePicker As Long = 3 Public Const gclmsoFileDialogFolderPicker As Long = 4 Public Const gclmsoFileDialogOpen As Long = 1 Public Const gclmsoFileDialogSaveAs As Long = 2
CreateTextFile Method
I’ll use the CreateTextFile Method of the FileSystemObject (FSO) to create a TextStream Object and write a little message to the file:
Option Explicit
Sub WriteToText()
'Author : Winston Snyder
'Date : 2/12/2014
'Purpose : Write to a text file
'Declare variables
Dim fso As Object
Dim fsoFolder As Object
Dim fsoFile As Object
Dim ts As Object
Dim strFileName As String
Dim strFolderName As String
'Allow the user to choose a folder location to save the text file to
strFolderName = GetFolder
'Get file name from user
strFileName = GetUserInput(strPrompt:="What would you like to name the file", _
strTitle:="File Name")
'Create a FileSystemObject (FSO)
Set fso = GetFileSystemObject
'Create a text file
fso.CreateTextFile strFolderName & "\" & strFileName & ".txt"
'Create an FSO file for the text file just created
Set fsoFile = fso.GetFile(strFolderName & "\" & strFileName & ".txt")
' Open a TextStream for output.
Set ts = fsoFile.OpenAsTextStream(gclForWriting, gclTristateUseDefault)
' Write to the TextStream
ts.WriteLine "Jeff Weir"
ts.WriteLine "is a prolific blogger!"
ts.Close
'Tidy up
Set ts = Nothing
Set fsoFile = Nothing
Set fso = Nothing
End Sub
Append To A Text File
We don’t always want to create a new text file. Sometimes we want to append to an existing text file. We can use the OpenTextFile Method of the FileSystemObject:
Sub AppendToText()
'Author : Winston Snyder
'Date : 2/15/2014
'Purpose : Append to a text file
'Declare variables
Dim fso As Object
Dim fsoFile As Object
Dim ts As Object
Dim strFileName As String
'Allow the user to choose a file to append to
strFileName = GetFile()
'Create a FileSystemObject (FSO)
Set fso = GetFileSystemObject
'Create an FSO file for the text file just created
Set fsoFile = fso.GetFile(strFileName)
' Open a TextStream for output.
Set ts = fsoFile.OpenAsTextStream(gclForAppending, gclTristateUseDefault)
' Write to the TextStream
ts.WriteLine
ts.WriteLine "Mike Alexander is a handsome devil!"
ts.Close
'Tidy up
Set ts = Nothing
Set fsoFile = Nothing
Set fso = Nothing
End Sub
At the GetFile() Dialog prompt, I chose the file I created in the “CreateTextFile Method”. I then used the constant, “gclForAppending” to specify that the new content was to be appended to the existing file. Had I used the constant, “gclForWriting”, the original contents would have been overwritten.
The Functions
Here are the Functions() I used with the code snippets above
FileDialogFolderPicker
Public Function GetFolder() As String
Dim fd As FileDialog
Dim strFolderName As String
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.Title = "Please select a folder"
.AllowMultiSelect = False
.Show
strFolderName = .SelectedItems(1)
End With
GetFolder = strFolderName
Set fd = Nothing
End Function
GetFileSystemObject
Public Function GetFileSystemObject() As Object
On Error Resume Next
Set GetFileSystemObject = CreateObject("Scripting.FileSystemObject")
End Function
GetUserInput
Public Function GetUserInput(strPrompt As String, _
strTitle As String) As String
Dim strUserInput As String
strUserInput = InputBox(Prompt:=strPrompt, _
Title:=strTitle)
GetUserInput = strUserInput
End Function
FileDialogFilePicker
Public Function GetFile() As String
Dim fd As FileDialog
Dim strFileName As String
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Title = "Please select a file"
.AllowMultiSelect = False
.Show
strFileName = .SelectedItems(1)
End With
GetFile = strFileName
Set fd = Nothing
End Function
The sample Procedures() given are fine for learning and understanding how to create text files and how to write and append data to the files. But how can we leverage these in a business environment to solve business needs and goals?
Merge Text Files
We may have a series of text files that we wish to merge into 1. Back in November, 2013, Ken Puls showed us how to use Power Query to import multiple text files into a Data Model (Power Pivot). All well and good. Let’s see if we can merge text files using the TextStream Object.
Here are some .csv files that I would like to merge together:
Sub MergeTextFiles()
'Author : Winston Snyder
'Date : 2/15/2014
'Purpose : Merge text files in a folder
'Declare variables
Dim fso As Object
Dim fsoFolder As Object
Dim fsoFileOutput As Object
Dim fsoFile As Object
Dim tsOutput As Object
Dim tsInput As Object
Dim strFolderInputFiles As String
Dim strFolderOutputFiles As String
Dim strFileName As String
Dim strMisc As String
'Allow the user to choose a folder that contains files to be merged
strFolderInputFiles = GetFolder(strTitle:="Folder for files to be merged")
'Allow the user to choose a folder location for the output file
strFolderOutputFiles = GetFolder(strTitle:="Folder for output files")
'What to name the output file
strFileName = GetUserInput(strPrompt:="What would you like to name the file", _
strTitle:="File Name")
'Create a FileSystemObject (FSO)
Set fso = GetFileSystemObject
'Get an FSO folder for the input files
Set fsoFolder = fso.GetFolder(strFolderInputFiles)
'Create a text file for output
fso.CreateTextFile strFolderOutputFiles & "\" & strFileName & ".txt"
'Create an FSO file for the text file just created
Set fsoFileOutput = fso.GetFile(strFolderOutputFiles & "\" & strFileName & ".txt")
'Open a TextStream for output.
Set tsOutput = fsoFileOutput.OpenAsTextStream(gclForAppending, gclTristateUseDefault)
'Loop through the files in the input folder
For Each fsoFile In fsoFolder.Files
Set tsInput = fsoFile.OpenAsTextStream(gclForReading, gclTristateUseDefault)
Do Until tsInput.AtEndOfStream
strMisc = tsInput.ReadLine 'Read from the input file
tsOutput.WriteLine strMisc 'Write to the output file
Loop
Next fsoFile
'Tidy up
Set tsInput = Nothing
Set tsOutput = Nothing
Set fsoFolder = Nothing
Set fso = Nothing
End Sub
Here is the merged file.
Pretty good, except the headers are repeating. I want to revise the code a bit to only include the header from the first file and skip the header on the subsequent files. The revised code:
Sub MergeTextFilesFirstFileHeader()
'Author : Winston Snyder
'Date : 2/15/2014
'Purpose : Merge text files in a folder
'Comments : Only uses header row from the first file
' subsequent files, header row is skipped
'Declare variables
Dim fso As Object
Dim fsoFolder As Object
Dim fsoFileOutput As Object
Dim fsoFile As Object
Dim tsOutput As Object
Dim tsInput As Object
Dim strFolderInputFiles As String
Dim strFolderOutputFiles As String
Dim strFileName As String
Dim strMisc As String
Dim blnTest As Boolean
'Initialize variables
blnTest = True 'First time through loop
'Allow the user to choose a folder that contains files to be merged
strFolderInputFiles = GetFolder(strTitle:="Folder for files to be merged")
'Allow the user to choose a folder location for the output file
strFolderOutputFiles = GetFolder(strTitle:="Folder for output files")
'What to name the output file
strFileName = GetUserInput(strPrompt:="What would you like to name the file", _
strTitle:="File Name")
'Create a FileSystemObject (FSO)
Set fso = GetFileSystemObject
'Get an FSO folder for the input files
Set fsoFolder = fso.GetFolder(strFolderInputFiles)
'Create a text file for output
fso.CreateTextFile strFolderOutputFiles & "\" & strFileName & ".txt"
'Create an FSO file for the text file just created
Set fsoFileOutput = fso.GetFile(strFolderOutputFiles & "\" & strFileName & ".txt")
'Open a TextStream for output.
Set tsOutput = fsoFileOutput.OpenAsTextStream(gclForAppending, gclTristateUseDefault)
'Loop through the files in the input folder
For Each fsoFile In fsoFolder.Files
Set tsInput = fsoFile.OpenAsTextStream(gclForReading, gclTristateUseDefault)
If blnTest = True Then
blnTest = False
Else
tsInput.SkipLine 'Move the file pointer to the line below the header
End If
Do Until tsInput.AtEndOfStream
strMisc = tsInput.ReadLine 'Read from the input file
tsOutput.WriteLine strMisc 'Write to the output file
Loop
Next fsoFile
'Tidy up
Set tsInput = Nothing
Set tsOutput = Nothing
Set fsoFolder = Nothing
Set fso = Nothing
End Sub
Awesome! :-) The solution was to use the SkipLine Method of the TextStream Object everytime through the loop other than the first time:
If blnTest = True Then blnTest = False Else tsInput.SkipLine 'Move the file pointer to the line below the header End If
Read From Text File
Another common problem, is to read the contents of a text file into Excel. I’ll demonstrate some code to take care of this using comma separated values (csv), but you can use any kind of delimiter such as tab, space, pipe “|”, etc….
Sub ReadTextFileIntoExcel()
'Author : Winston Snyder
'Date : 2/15/2014
'Purpose : Read data from text file, output to Excel
'Declare variables
Dim fso As Object
Dim fsoFile As Object
Dim ts As Object
Dim vArrData() As Variant
Dim strLine() As String
Dim strData() As String
Dim i As Long
Dim j As Long
Dim strTextFileName As String
Dim strFolderOutputFiles As String
Dim strExcelFileName As String
Dim strReadAll As String
'User - choose a text file to read into Excel
strTextFileName = GetFile()
'User - choose a folder location for the output file
strFolderOutputFiles = GetFolder(strTitle:="Folder for output files")
'User - name the output file
strExcelFileName = GetUserInput(strPrompt:="What would you like to name the file", _
strTitle:="File Name")
'Create a FileSystemObject (FSO)
Set fso = GetFileSystemObject
'Create an FSO file for the user selected text file
Set fsoFile = fso.GetFile(strTextFileName)
'Open a TextStream for reading
Set ts = fsoFile.OpenAsTextStream(gclForReading, gclTristateUseDefault)
'Read the text file and store it in a string variable
strReadAll = ts.ReadAll
'Split each line of the text document based on the new line delimiter
strLine = Split(strReadAll, vbNewLine)
'Get number of elements in the line
strData = Split(strLine(0), ",")
'Redim the data array
ReDim vArrData(LBound(strData) To UBound(strData), LBound(strLine) To UBound(strLine))
'Erase the strData Array
Erase strData
'Loop the strLine Array, split each line into data elements, load the data elements into the data array
For i = LBound(strLine) To UBound(strLine)
strData = Split(strLine(i), ",")
For j = LBound(strData) To UBound(strData)
vArrData(j, i) = strData(j)
Next j
Next i
'Output the array to an Excel Worksheet
Call ArrayToRange(vArr:=vArrData, _
strPath:=strFolderOutputFiles, _
strFileName:=strExcelFileName)
'Tidy up
'Erase arrays
Erase vArrData
Erase strLine
Erase strData
'Destroy objects
Set ts = Nothing
Set fsoFile = Nothing
Set fso = Nothing
End Sub
'----------------------------------------------------------------------------------------
Public Sub ArrayToRange(ByRef vArr() As Variant, _
strPath As String, _
strFileName As String)
Dim wbNew As Workbook
Dim wsNew As Worksheet
Dim rngNew As Range
Dim r As Long
Dim c As Long
c = UBound(vArr, 1) '1st dimension of array
r = UBound(vArr, 2) '2nd dimension of array
Set wbNew = Workbooks.Add
Set wsNew = wbNew.Worksheets("Sheet1")
Set rngNew = wsNew.Range("A1")
'Resize the destination range
'Use +1, +1 for Rows and columns since array begins at (0,0)
rngNew.Resize(r + 1, c + 1).Value = Application.Transpose(vArr)
wbNew.SaveAs strPath & "\" & strFileName & ".xlsx"
wbNew.Close
Set rngNew = Nothing
Set wsNew = Nothing
Set wbNew = Nothing
End Sub
Tidy Up
That’s it for today. Long post, sorry ’bout that. That last snjppet ended up being about Arrays as much as it was about the TextStream Object. Now, where did I leave my worms? I’m going fishing. :-)
Download the file from SkyDrive
Previous Posts At dataprose.org – Scripting
Microsoft Scripting
- Microsoft Scripting Center
- FileSystemObject Reference (Windows Scripting)
- TextStream Object
- 4 Guys From Rolla – FSO