Pre3

Here’s Bill Bowerman (facing) with Steve “Pre” Prefontaine (back turned). Pre was an amazing long distance runner, at one point in his career holding 9 different long distance running records. 4 of Pre’s records remain unbroken to this day. Pre died in an automobile accident in May, 1975. He was only 24 years old.

Bowerman and one of his former student athletes founded Blue Ribbon Sports which eventually became Nike, [Just Do It]

The 1997 movie, Prefontaine stars Jared Leto as Pre and R. Lee Ermey as Bowerman. Ermey is always entertaining in everything he does in his over the top approach and larger than life portrayals, check it out.

Today’s post, however, is not about running or movies, it is about the DoCmd Object of the Access Object Model. The DoCmd Object has 66 different Methods as of Office 2013. I’ll look at some of the Methods over a series of posts and how they may be leveraged in Microsoft Office development. I’ll begin with the TransferSpreadsheet Method.

I won’t bore you by reviewing the parameters of the Method, you can read those for yourself here. Instead, I’ll jump right in and demonstrate some VBA you may use to update your Access Tables from Excel Worksheets.


    edit: This is a re-boot of sorts. Readers of this blog (both of you) will recall I posted an article back in November, 2013. That article was lost to the cybersphere during the great melt down of aught thirteen when I hosed my function.php file.


TransferSpreadsheet Method

I want to transfer a list of NFL teams from an Excel Worksheet to a Table in an Access Database. This will be a Dimension (Dim) Table, so all I need in the Table is a Primary Key and the name of each Team. I will want to automate this routine and attempt to insert any number of teams at any time based on transformative process I use in Excel to create files that I will want to attempt to insert into the Team Dimension Table. It is imperative that a team only exist 1 time in the Dimension (dim) Table.

tblTeamsPK

I created the table and named it dimTeams. I named the first field TeamKey, set the field as the Primary Key for the table and set the datatype to autonumber.

tblTeamsDesignFieldPropertiesFinal

Next, I added the field, TeamName, set the datatype to Short Text, and in the Field Properties pane, changed the Indexed property to Yes (No Duplicates). I saved all changes to the table. I am now ready to add some VBA to Load the table using DoCmd.TransferSpreadsheet.

DoCmd.TransferSpreadsheet VBA

Option Compare Database

Sub TransferSpreadsheet()
    'Author: Winston Snyder
    'Date: 4/5/2014
    'Purpose: Transfer Excel Worksheet to Access Table
    
    'Declare variables
        Const strPATH   As String = "C:\tmp\"
        Const strFILE   As String = "xlTeams.xlsx"
        Const strTABLE  As String = "dimTeams"

    With DoCmd
        'Turn warnings off
            .SetWarnings False

        'Transfer spreadsheet
            .TransferSpreadsheet _
                TransferType:=acImport, _
                TableName:=strTABLE, _
                FileName:=strPATH & strFILE, _
                HasFieldNames:=True

        'Turn warnings on
            .SetWarnings True
            
    End With
    
End Sub

dimTeamsLoadedFinal

That works well. All current 32 teams of the NFL were loaded to the dimTeams Table. I’ll try to load the Table again. Recall, I set the Index property to Yes (No Duplicates) so no duplicate values should be loaded to the Dimension Table. I’ll comment out the 2 lines in code that turn warning messages off and back on so I can review any error messages :

        'Turn warnings off
            '.SetWarnings False

        'Turn warnings on
            '.SetWarnings True

Here is the information message I receive from Access when I re-spin the code :

UnableToAppend

Because I set the Index property on the TeamName field, to Yes (No Duplicates), all 32 records are rejected and nothing additional is loaded. Next, I’ll amend the Excel Workbook to add teams from the now defunct NFL Europe just so I can test that teams will indeed be added if new teams are added to the Excel Workbook.

xlNFLEuropeTeams

I added 9 teams from NFL Europe to the Excel Workbook and ran the VBA code again :

dimTeamsTableUpdateFinal

Only the 9 new team names from the Excel Workbook were added to the dimTeams table. Everything is working as I intended. I deleted everything from the dimTeams table and Compacted and Repaired the Database to force autonumbering to start at 1 again on the next step.

Make The VBA More Dynamic / Flexible

I don’t like that I hard-coded in VBA Code the file path, the file name and the table name. I’ll introduce some functions to make the code a bit more flexible and dynamic.

FileDialogFilePicker

I have discussed the FileDialog Property of the Application Object in previous posts. FileDialog’s are a great way to interact with users at run-time to allow the user to select a file to perform operations on.

First, I added these 4 global constants to my Globals Module. These constants are based on the MSOFileDialogType Enumeration

Public Const gclmsoFileDialogFilePicker = 3                 'File Picker
Public Const gclmsoFileDialogFolderPicker = 4               'Folder Picker
Public Const gclmsoFileDialogOpen = 1                       'Open
Public Const gclmsoFileDialogSaveAs = 2                     'SaveAs
Public Function GetSelectedFile() As String
     
    'Declare variables
        Dim fd                  As Object
        Dim strFileName         As String
 
    'Initialize variables
        Set fd = Application.FileDialog(gclmsoFileDialogFilePicker)
    
    'User - select file
        With fd
            .AllowMultiSelect = False
            .Show
            strFileName = .SelectedItems(1)
        End With
 
    'Pass value to function
        GetSelectedFile = strFileName
        
    'Tidy up
        Set fd = Nothing
    
End Function

I selected the file, “xlTeams.xlsx”. The function returns :

C:\tmp\xlTeams.xlsx

So I’ll need a functions to split the folder path and file name into separate substrings.

GetSegmentsFromFullFileName

This function returns either a substring of either the path or the file name. If the user specifies, “strSubstringType:=Path”, then the path will be returned. Otherwise the file name without the path will be returned.

Public Function GetSegmentsFromFullFileName(strCompleteFileName As String, _
                                            strSubstringType As String) As String

    'Declare variables
        Dim strSegment As String

    'Get substring segment
        Select Case strSubstringType
            Case "Path"
                strSegment = Mid(strCompleteFileName, 1, InStrRev(strCompleteFileName, "\"))
            Case Else
                strSegment = Trim(Mid(strCompleteFileName, InStrRev(strCompleteFileName, "\") + 1, Len(strCompleteFileName) - InStrRev(strCompleteFileName, "\")))
        End Select
    
    'Pass value to function
        GetSegmentsFromFullFileName = strSegment

End Function

I selected the file, “xlTeams.xlsx”. The function returns either:

C:\tmp\ or xlTeams.xlsx depending on the value the user passes for “strSubstringType”

I need one more function to take the file name and convert it to the Access Table Name.

GetTableNameFromFileName

Public Function GetTableName(strFile As String) As String

    'Declare variables
        Dim strTable As String

    'Get table name from file name
    'In Len, include front and end segments to drop
        strTable = "dim" & Trim(Mid(strFile, 4, Len(strFile) - 7))

    'Pass the value to a function
        GetTableName = strTable
End Function

The function returns :

dimTeams

Now I just need to revise the original sub procedure to use the functions instead of hard-coding in values for the path, the file name and the name of the Access Table.

TransferSpreadsheetUsingFunctions

Sub TransferSpreadsheetUsingFunctions()

    'Purpose: Transfer Excel Worksheet to Access Table
    'Log    :
    '---------------------------------------------------------------------------------------------------------------------------------------------------
    'Date               Developer                   Action                      Comments
    '---------------------------------------------------------------------------------------------------------------------------------------------------
    '4/5/2014           ws                          Created
    '4/6/2014           ws                          Modified                    Added functions to remove hard-coding of path, file name and table name
    
    'Declare variables
        Dim strFullFileName             As String
        Dim strPath                     As String
        Dim strFileNameSubstring        As String
        Dim strTable                    As String

    'Initialize variables
        'User - call file dialog to get file
            strFullFileName = GetSelectedFile()
            
        'Get folder path from full file name
            strPath = GetSegmentsFromFullFileName(strCompleteFileName:=strFullFileName, _
                                                  strSubstringType:="Path")
            
        'Get file name substring from full file name
            strFileNameSubstring = GetSegmentsFromFullFileName(strCompleteFileName:=strFullFileName, _
                                                               strSubstringType:="File")
            
        'Get Access Table name from the file name
            strTableName = GetTableName(strFile:=strFileNameSubstring)
            
    'Transfer spreadsheet to table
        With DoCmd
            'Turn warnings off
                .SetWarnings False
    
            'Transfer spreadsheet
                .TransferSpreadsheet _
                    TransferType:=acImport, _
                    TableName:=strTableName, _
                    Filename:=strPath & strFileNameSubstring, _
                    HasFieldNames:=True
    
            'Turn warnings on
                .SetWarnings True
                
        End With
    
End Sub

dimTeamsLoadFinal

Great! That works well. The dimTeams Table is once again loaded. But what if there is more than one file to load?

Multiple Files…Multiple Tables

So far, so good. But chances are good you may have multiple files to load to multiple tables. I have code above to load one file to one table, so now I just need to add the ability to loop through files in a folder and load each file while I am looping.

LoadFilesToTables2

To loop through files in a folder, I like to use the FileSystemObject (FSO) which is a top level object in Microsoft Scripting Runtime Library (scrrun.dll). I covered FSO previously as part of my series on Microsoft Scripting in VBA.


    edit: As per usual, 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.

    1. Beyond Excel
    2. JP Software Technologies


Some New Functions

I’ll need some new functions to create the FileSystemObject (FSO) and to work with the FileDialog Object.

Create FileSystemObject

This function creates a FileSystemObject. This is the route to go if you are using Late Binding for creating an object.

Public Function GetFileSystemObject() As Object
      
    On Error Resume Next
    Set GetFileSystemObject = CreateObject("Scripting.FileSystemObject")
      
End Function

File Dialog

I modified the FileDialog Function I introduced earlier. The function now accepts one argument, “strDialogType” so the function may be used to return either the name of a folder or the name of a file based on the value of strDialogType as declared by the user :

Public Function GetFDObjectName(strDialogType As String) As String

    'Returns either the name of a folder or the name of a file based on the type passed into the function, "strDialogType"
  
    'Declare variables
        Dim fd As FileDialog
        Dim strObjectName As String
        Dim strTitle As String
        
    'Choose if user requested a folder dialog or other
        Select Case strDialogType
            Case "Folder"                                                               'Folder Dialog
                strTitle = "Please select a folder"
                Set fd = Application.FileDialog(gclmsoFileDialogFolderPicker)
            Case Else
                strTitle = "Please select a file"                                       'File Dialog
                Set fd = Application.FileDialog(gclmsoFileDialogFilePicker)
        End Select
        
    'Invoke filedialog
        With fd
            .Title = strTitle
            .AllowMultiSelect = False
            .Show
            strObjectName = .SelectedItems(1)
        End With
        
    'Pass value to function
        GetFDObjectName = strObjectName
    
    'Tidy up
        Set fd = Nothing
        
End Function

The Final Sub()

I took the original Sub() and made it a Private Sub() of the new main Sub(). The Main Sub() gets the Absolute Path of a file and passes it to the Private Sub(). The Main Sub() is immediately below, the Private Sub() follows the Main Sub()

Option Compare Database

Sub LoadExcelFilesToAccessTables()
     
    'Author     :   Winston Snyder
    'Date       :   4/14/2014
    'Purpose    :   Load files from folder to target tables in database
     
    'Declare variables
        Dim fso As Object
        Dim fsoFoler As Object
        Dim strFolderInputFiles As String
        Dim strAbsolutePath As String
 
    'User - choose a folder that contains files to be loaded to the database
        strFolderInputFiles = GetFDObjectName(strDialogType:="Folder")
 
    'Create a FileSystemObject (FSO)
        Set fso = GetFileSystemObject
         
    'Get an FSO folder for the input files
        Set fsoFolder = fso.GetFolder(strFolderInputFiles)
         
    'Load each file in the folder to it's respective Table in Access
        For Each fsoFile In fsoFolder.Files
            strAbsolutePath = fso.GetAbsolutePathName(fsoFile)
            Call TransferSpreadsheetRoutine(strFullFileName:=strAbsolutePath)
        Next fsoFile
         
    'Tidy up
        Set fsoFolder = Nothing
        Set fso = Nothing
 
End Sub




Private Sub TransferSpreadsheetRoutine(strFullFileName As String)

    'Arguments: Accepts 1 argument, "strFullFileName" as a string
    'Resuts   : Split full file name into path and file name segments
    '           Create table name from file name
    '           Transfer spreadsheet to target database table

    
    'Declare variables
        Dim strPath                     As String
        Dim strFileNameSubstring        As String
        Dim strTable                    As String

            
        'Get folder path from full file name
            strPath = GetSegmentsFromFullFileName(strCompleteFileName:=strFullFileName, _
                                                  strSubstringType:="Path")
            
        'Get file name substring from full file name
            strFileNameSubstring = GetSegmentsFromFullFileName(strCompleteFileName:=strFullFileName, _
                                                               strSubstringType:="File")
            
        'Get Access Table name from the file name
            strTableName = GetTableName(strFile:=strFileNameSubstring)
            
    'Transfer spreadsheet to table
        With DoCmd
            'Turn warnings off
                .SetWarnings False
    
            'Transfer spreadsheet
                .TransferSpreadsheet _
                    TransferType:=acImport, _
                    TableName:=strTableName, _
                    FileName:=strPath & strFileNameSubstring, _
                    HasFieldNames:=True
    
            'Turn warnings on
                .SetWarnings True
                
        End With

End Sub

TablesUpdated

I changed the view of the Navigation Pane in MS Access to View By Details. There are a couple of items of note:

  1. The dimTeams table was created on 11/7/2013 and modified on 4/16/2014
  2. The other 2 tables were created on 4/16/2014 and modified on 4/16/2014

I intentionally deleted the 2 tables before spinning the process, I wanted to show you, that when you use the TransferSpreadsheet Method, if the table does not already exist, it will be created! That is pretty cool. However, I have seen instances when I use TransferSpreadsheet Method and I did not explicitly create the table and setup all the datatypes for each field – I end up with some unwanted results. So I now create all tables, fields ahead of time so I explicitly control all datatypes.

Power Pivot

PowerPivotImport

I now have a great process for keeping my Dimension (dim) Tables up-to-date with any kind of frequency that I need – usually monthly after month-end close to pick up any changes in accounts, or organizational structure. I just spin my process to create my Excel files, spin the DoCmd process to import the Excel file to the appropriate dim table and refresh the Data Model in the Power Pivot window.

PowerPivotRefresh

Slowly Changing Dimensions (SCD)

What I demonstrated here, is an example of a Type 2 Slowly Changing Dimension (SCD). There are 6 different SCD’s. You may read more about them here.

If this Data Model was properly constructed, I would most likely have 3 different entries (maybe more) for the now Arizona Cardinals.

  1. The club was established in Chicago in 1898
  2. They moved to St. Louis Missouri in 1960
  3. They moved to Phoenix, Arizona in 1988

There are many other examples along those lines – so Type 2 SCD.

Tidy Up

That’s it for today – lot’s to do on my Honey DoCmd List. This is a fairly long post with hopefully a little something for everyone.

, , , , , , , ,

FishingTrim

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:

  1. FileSystemObject (FSO)
  2. Regular Expressions

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.

    1. Beyond Excel
    2. JP Software Technologies


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:

  1. TristateUseDefault = -2 ; Opens the file using the system default
  2. TristateTrue = -1 ; Opens the file as Unicode
  3. 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

Textstream2

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.

TextFileAppend2

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:

TextFilesForMerge

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.

MergedFilesMultipleHeaders

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

MergedFilesOneHeader

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

TextToExcelFinal

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

  1. The FileSystemObject
  2. Regular Expressions

Microsoft Scripting

  1. Microsoft Scripting Center
  2. FileSystemObject Reference (Windows Scripting)
  3. TextStream Object
  4. 4 Guys From Rolla – FSO

Additional Resources – Arrays

  1. VBA Arrays And Worksheet Ranges
  2. Understanding Arrays
  3. Redim Statement
, , , ,

BeatlesLg
I like music – lots of different kinds of music, including The Beatles pictured here. These days, I’m more into “Adult Alternative” music, but I still like to listen to some stuff from the ’60’s and ’70’s every now and again.

Around these parts, we get “Breakfast With The Beatles” with Andre Gardner every Sunday from 7am-9am. Check your local listings to see if it is available in your area or you can stream it on KSLX. Really excellent show if you are into The Beatles.

However, today’s post is not about music or The Beatles. It is about Merging Excel Workbooks. Over on the LinkedIn Excel Groups there are many questions about merging data from several Excel Workbooks into 1 Workbook. Many folks suggest linking the workbooks using a formula. Others suggest using the INDIRECT() function. I prefer to use some VBA to copy the desired data from the Source Workbooks to the Destination Workbook.

All testing, screen shots, code in this post are from Office 365. If you are using another version of Excel, your results may vary (though they should not).

Linking Files

A common way to get data from one file to another is to link them. In this sample, I opened 2 Excel files, entered a value in 1 file, activated another file, typed, “=” and clicked on a cell in the 1st file:

LinkFiles2

DestinationWB.xlsx in the active workbook and cell $A$1 is selected. The formula bar give us:

  1. [SourceWB.xlsx] <- The name of the workbook
  2. Sheet1! <- The name of the worksheet
  3. $A$1 <- The cell reference

When I close the source workbook, the file path is added to the linked cell formula:

LinkedCellwPath

The folder location ‘C:\Data\ has been added to the linked formula.

There are a few things I do not like about linked cells

  1. The absolute references were added automatically. If I drag the formula to the right, the formula will still reference $A$1, not $B$1 as we may require
  2. What happens if a Row is added at Row 1 pushing all subsequent rows down by 1? This could cause an error in the linked formula, erroneous results, or at least the need for additional maintenance.
  3. What happens if the source file(s) are moved from the referenced folder location?

Here is the formula with the file in the folder ‘C:\OriginalFolder\.

PathReference

Linking Files – File Migration

One problem with linking files is that files move in our directory structures from time-to-time. We may initiate this move ourselves as we come up with a new way to organize our file structures. Other times this move may be initiated by the IT Department as they are updating or migrating storage.

Let’s see what happens to the original link formula when I move the source file.
I moved the file from ‘C:\OriginalFolder\ to ‘C:\NewFolder\ in Windows Explorer.

MoveFileFinal

Now when I try to update the link value in the Destination Workbook, I receive an error message

EditLinksErrorFinal

I can click on the change source button, but I would like a solution that provides for as little maintenance needs as possible.

Linking Files – Data Moves On Worksheet

The original linked formula is linked to cell A1 in the source file. What happens if, unbeknownst to you, a user inserts a blank row at A1 and all of the data shifts from A1 to A2?

UpdateValueFinal

The Edit Links Dialog status reads, “OK”, but it is not. The Linked Cell formula is still linked to Cell $A$1 and the updated Cell Value is now 0. We could use Find-Replace to update from $1 to $2, but that could have unintended consequences. What if other workbook moved data 2-3 rows? You see the point I’m sure.

Copy Data From Source To Destination

I propose to loop through a folder and copy some data from a worksheet for each workbook found in the folder – I would like the solution to be as dynamic as possible. As I am looping, I will paste the data on a worksheet in Top-Down fashion such that the first file results will be near the top, then the data from the second file and so on.

For today, my source files all have an Excel Table in them, though we could make the process work with Ranges as well with just a bit more work. For additional resources working with Excel Tables, see the links at the bottom of the post.

Some Functions & Properties

First, I’ll look at some VBA functions that I am going to use in the final code. These functions will make your code more dynamic and user-friendly.

CurDir

CurDir returns the current path. I use CurDir to trap the current path so I can restore it at then before I change the path to make navigating the file structure faster. Use as follows:

Option Explicit

Sub foo2()

    Dim strDirectory As String
    strDirectory = CurDir()
    Debug.Print strDirectory
    
End Sub

Output:

C:\Users\wsnyder\Documents

ChDir

ChDir changes the the current path. I use ChDir to change the current path to get the user closer the final folder they will eventually choose using the FileDialog to select a folder for processing. Use as follows:

Option Explicit

Sub foo2()

    Dim strDirectory As String
    strDirectory = "C:\Data\"
    ChDir (strDirectory)
    Debug.Print CurDir()
    
End Sub

Output:

C:\Data

FileDialog Property

The FileDialog Property of the Application Object returns a FileDialog Object. This give you the ability to interact with users at runtime by allowing the user to choose File(s) or Folder(s) to work with. The FileDialog accepts one argument, the DialogType.

There are 4 DialogTypes in the MsoFileDialogType Enumeration :

  1. msoFileDialogFilePicker
  2. msoFileDialogFolderPicker
  3. msoFileDialogOpen
  4. msoFileDialogSaveAs

For today’s purposes, I’ll use msoFileDialogFolderPicker

Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)

The Setup…

As I mentioned earlier, each source file has an Excel Table in it. I would like to loop through each file in the source folder and copy the DataBodyRange of the Excel Table to the destination workbook. Additionally, on the first pass, I would also like to copy the HeaderRowRange to create headers in the destination workbook. Lastly, I would like to add some data to the right of the data from the source files, such as the date the data was copied and the name of the source file.

Create Some Sample Data and Files

I quickly whipped up some sample data using Dick’s Random Data Generator and creatively saved the files as File1.xlsx, File2.xlsx, File3.xlsx.

TablesLayered

Again, I highlighted the data [Ctrl] + [a] and added an Excel Table [Ctrl] + [t] in each file. I applied a different Table Style to each Table simply to highlight the fact that there are 3 different Tables in 3 different Excel files. If you need to brush up on Excel Tables or need to start at the beginning:

  1. Excel Table Tutorial – Contextures
  2. Sur la Excel Table
  3. Listing Toward ListObjects

Loop Through Files In A Folder

When I need to loop through files in a folder – I use the FileSystemObject (FSO). The FileSystemObject is a top-level object in the Microsoft Scriping Runtime Library (Scrrun.dll). Here are some additional references if you need to brush up or are not familiar with FSO.

  1. JP Software Tech
  2. Chip Pearson
  3. 4 Guys From Rolla
  4. dataprose.org
  5. MSDN

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 the “Additional Resources” at bottom for links to detailed explanation of Late / Early Binding.

Copying Data From Source To Destination

It’s finally time to copy the data from the source workbooks to the destination workbook. I’m using three files with 50 records each, but you could use this code with an unlimited number of records or variable number of records and unlimited number of files (3, 10, 50,…) – as long as you do not exceed 1,048,576 rows (though I would never use that many row in Excel – time to consider a database).

Option Explicit

Sub CopyDataFromSourceFiles()
    
    'Author         :           Winston Snyder
    'Created Date   :           1/26/2014
    'Comments       :           Assumes each source file contains at least one list object (Excel Table)
    
    'Delare variables
        Dim wb                  As Workbook
        Dim wbData              As Workbook
        Dim ws                  As Worksheet
        Dim wsData              As Worksheet
        Dim rngData             As Range
        Dim rngDestination      As Range
        Dim lo                  As ListObject
        Dim fso                 As Object
        Dim fsoFolder           As Object
        Dim fsoFile             As Object
        Dim strSelectedFolder   As String
        Dim strCurrentPath      As String
        Const strSpecifiedPath  As String = "C:\"
        Dim lngRows             As Long
        Dim blnFlag             As Boolean
        
    'Excel environment - speed things up
        With Application
            .ScreenUpdating = False
            .DisplayAlerts = False
            .EnableEvents = False
            .Calculation = xlCalculationManual
        End With
        
    'Initialize variables
        Set wb = ThisWorkbook
        Set ws = wb.Worksheets("Data")
        blnFlag = True
        
    'Clear data from control workbook from previous consolidations
        ws.UsedRange.ClearContents
    
    'Get the current path, so reset the path at the end of the procedure
        strCurrentPath = CurDir()
        
    'Set the target directory to get the user closer to the working folder
    'This will minimize the time the user must spend drilling into the file system
    'once they are presented with the FileDialog
        ChDir (strSpecifiedPath)
    
    'Create a FileSystemObject
        Set fso = GetFSO

    'Prompt the user to select a folder
    'Return the path of the selected folder
        strSelectedFolder = GetSelectedFolder
        
    'Get the FSO Folder of the selected folder
        Set fsoFolder = fso.GetFolder(strSelectedFolder)
        
    'Loop each file in folder
    'Copy data from each file to control workbook
        For Each fsoFile In fsoFolder.Files
            Debug.Print fsoFile.Name
            Set wbData = Workbooks.Open(fsoFile)
            Set wsData = wbData.Worksheets("Sheet1")
            
            'Get next blank row from destination worksheet
            'If first time, need row 1, else, next blank row
                lngRows = GetRows(ws:=ws)
                If blnFlag = False Then lngRows = lngRows + 1
                
            'The Destination Range
                Set rngDestination = ws.Cells(lngRows, 1)
            
            'If first time, include the header row
                With wsData
                    For Each lo In .ListObjects
                        If blnFlag = True Then
                            Set rngData = Union(lo.HeaderRowRange, lo.DataBodyRange)
                            blnFlag = False
                        Else
                            Set rngData = lo.DataBodyRange
                        End If
                    Next lo
                End With
                
            'Copy the Data Range to the Destination Range
                rngData.Copy
                rngDestination.PasteSpecial xlPasteValuesAndNumberFormats
                
            'Close the source file
                wbData.Close
        
        Next fsoFile
        
    'Tidy up
        'Restore to original path
            ChDir (strCurrentPath)
            
        'Restore Excel environment
            With Application
                .ScreenUpdating = True
                .DisplayAlerts = True
                .EnableEvents = True
                .Calculation = xlCalculationAutomatic
            End With
            
        'Destroy objects
            Set fsoFolder = Nothing
            Set fso = Nothing
            Set rngData = Nothing
            Set rngDestination = Nothing
            Set ws = Nothing
            Set wb = Nothing
        
End Sub
'------------------------------------------------------------------------------------
Private Function GetRows(ws As Worksheet) As Long

    Dim r       As Long
    
    With ws
        r = .Cells(Rows.Count, 1).End(xlUp).Row
        GetRows = r
    End With
    
End Function
'------------------------------------------------------------------------------------
Private Function GetFSO()

    Dim fso             As Object
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set GetFSO = fso
    
    Set fso = Nothing

End Function
'-------------------------------------------------------------------------------
Private Function GetSelectedFolder() As String
    
    Dim diaFolder       As FileDialog
    Dim strFolder       As String

    Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
    With diaFolder
        .AllowMultiSelect = False
        .Show
        strFolder = .SelectedItems(1)
    End With

    GetSelectedFolder = strFolder
End Function

MergeSourceFiles

I formatted the output and hid some rows to show that there are 151 records as expected (3 files * 50 records each + 1 header row).

My favorite part of the code is here

'If first time, include the header row
                With wsData
                    For Each lo In .ListObjects
                        If blnFlag = True Then
                            Set rngData = Union(lo.HeaderRowRange, lo.DataBodyRange)
                            blnFlag = False
                        Else
                            Set rngData = lo.DataBodyRange
                        End If
                    Next lo
                End With

The properties of the ListObject (Excel Table) such as HeaderRowRange and DataBodyRange are 2 reasons why the ListObject is far superior to the Range Object. Couple these kinds of properties with the fact that you can move the Excel Table anywhere on the worksheet you want and add rows to the Table or redact rows from the Table and the consolidation code will still work flawlessly. No Excel Hell! Awesome!

Tidy Up

, , , , , , ,