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.

, , , , , , , ,