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