Importing union range into Access.

[Darren Bartrup]

Morning all,

I've been working on importing an Excel worksheet into Access allowing for the fact that the number of columns in my worksheet will change (so I can't have a single table with x number of fields).

The worksheet is basically a work count for the team; I've got 10 columns that contain team level data which I import into one table, I have a variable amount of columns for the team members - each team member uses three columns and I import this into a second table a team member at a time so I can normalise the data.

To do this my code opens the spreadsheet and creates a number of named ranges which are then used in the VBA TransferSpreadsheet method. This worked perfectly until I realised I had no way of creating a relationship between the individual data and the team level data. I need to import the date into the individual data so I can match it up - the problem here is that the date is in column B of the worksheet and not next to the team member data.

I used this code to create a UNION named range, which works as far as looking at it in Excel.

oXLApp.union(.Range(.Cells(4, 2), .Cells(oXLLastCell.row, 2)), .Range(.Cells(4, x), .Cells(oXLLastCell.row, x + 2))).Name = "TM" & lTeamMember

In Access it returns error message 3011. The Microsoft Access database engine could not find the object 'TM1'. Make sure the object exists and that you spell its name and the path name correctly. If 'TM1' is not a local object, check your network connection or contact the server administrator.
Is it possible to import a non-continuous range into Access using this method? It has to be that as it works if I don't include the date column.

My full code is below. The error line is highlighted in red, and the line that creates the named range is in blue.

Public Sub Main()

    ''''''''''''''''''
    'Excel variables '
    ''''''''''''''''''
    Dim vFile As Variant            'Full path to the Work Count spreadsheet.
    Dim oXLApp As Object            'Reference to Excel Application.
    Dim oXLWrkBk As Object          'Reference to workbook.
    Dim oXLWrkSht As Object         'Reference to worksheet.
    Dim oXLLastCell As Object       'Reference to last cell on worksheet.
    
    Dim x As Long                   'A general counter used in various places throughout the routine.
    Dim lTeamMember As Long         'Holds the count of team members in team.
    Dim colTeamMember As Collection 'Holds the names of team members in the team.
    Dim vTeamMember As Variant      'Holds individual team member names from colTeamMember.
    
    On Error GoTo ERROR_HANDLER


    ''''''''''''''''''''''''''''''''''''''''''''''
    'Ask for location of Work Count spreadsheet. '
    ''''''''''''''''''''''''''''''''''''''''''''''
    vFile = GetFile()
    
    Select Case GetExt(CStr(vFile))
    
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        'Only continue if the correct file type has been selected. '
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Case "xls", "xlsx", "xlsm"
            'TO DO: Check it's the correct Excel file.
            
            ''''''''''''''''''''''''''''''''''''''''''''''''''
            'Set or create a reference to visible Excel.     '
            'Open the report and set references to the data. '
            ''''''''''''''''''''''''''''''''''''''''''''''''''
            Set oXLApp = CreateXL(True)
            Set oXLWrkBk = oXLApp.WorkBooks.Open(vFile)
            Set oXLWrkSht = oXLWrkBk.WorkSheets("Workflows")
            Set oXLLastCell = LastCell(oXLWrkSht)
            
            With oXLWrkSht
                
                ''''''''''''''''''''''''''''''''''''''''''
                'Create a named range for the team data. '
                ''''''''''''''''''''''''''''''''''''''''''
                .Range("B4:K" & oXLLastCell.row).Name = "TeamData"
            
                ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                'Create a named range for each team member on worksheet. '
                ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                lTeamMember = 1
                Set colTeamMember = New Collection
                For x = 12 To oXLLastCell.Column Step 3
                    oXLApp.union(.Range(.Cells(4, 2), .Cells(oXLLastCell.row, 2)), _
                    .Range(.Cells(4, x), .Cells(oXLLastCell.row, x + 2))).Name = "TM" & lTeamMember
                    colTeamMember.Add CStr(.Cells(3, x)), CStr(lTeamMember)
                    lTeamMember = lTeamMember + 1
                Next x


            End With
            oXLWrkBk.Close True
            
            ''''''''''''''''''''''''''''''''''''''''''''''''
            'Empty the TeamData table and import new data. '
            ''''''''''''''''''''''''''''''''''''''''''''''''
            DoCmd.SetWarnings False
            DoCmd.RunSQL "DELETE * FROM tbl_TMP_TeamData"
            DoCmd.SetWarnings True
            
            DoCmd.TransferSpreadsheet TransferType:=acImport, _
                          SpreadsheetType:=acSpreadsheetTypeExcel12, _
                          TableName:="tbl_TMP_TeamData", _
                          FileName:=CStr(vFile), _
                          HasFieldNames:=True, _
                          Range:="TeamData"
                                                
            For x = 1 To lTeamMember
                
                ''''''''''''''''''''''''''''''''''''''''''''''''''''''
                'Empty the TeamMemberData table and import new data. '
                ''''''''''''''''''''''''''''''''''''''''''''''''''''''
                DoCmd.SetWarnings False
                DoCmd.RunSQL "DELETE * FROM tbl_TMP_TeamMemberData"
                DoCmd.SetWarnings True
            
                DoCmd.TransferSpreadsheet TransferType:=acImport, _
                              SpreadsheetType:=acSpreadsheetTypeExcel12, _
                              TableName:="tbl_TMP_TeamMemberData", _
                              FileName:=CStr(vFile), _
                              HasFieldNames:=True, _
                              Range:="TM" & x
            
            Next x
        
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        'This line should never be reached, as the file filter '
        'only allows for Excel files to be selected.           '
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Case Else
            MsgBox "Please select an Excel file type.", vbCritical + vbOKOnly, "File Selection Error."
        
    End Select


    On Error GoTo 0
    Exit Sub


ERROR_HANDLER:
    Select Case Err.Number
        
        Case Else
            MsgBox "Error " & Err.Number & vbCr & _
                " (" & Err.Description & ") in procedure Main."
            Err.Clear
    End Select
    
End Sub

Any help & pointers are greatly appreciated.

 

[Norie]

Couldn't you import all the data from Excel to Access and then do the normalization in Access?

 

[Darren Bartrup]

Hi Norie,

Thanks for replying.

I'm not sure importing it all into a single table would be the best way. The number of people in the team dictate how many columns are in the spreadsheet. At the moment there's 8, so the team member data on the worksheet covers L:AI - 3 columns per team member with repeated headings.

If I import all the data in one go I'll have to import into a new table, to cover the possibility of extra or less columns, so I'll have to set a reference to that table in the code. I'll then have to create queries based on fields that I don't know the name of, but do know the position of. I'm hoping now that you're going to tell me that it's not as hard as that though.

I could import the date column into a separate table and then append it to the employee table, but I'd have to be really careful that it all goes in in the correct order.
Or I could update the worksheet when importing to place the date next to each employee but I'm sure that's a long drawn out way of doing it.

 

[Norie]

I was thinking you could import into a new, temporary table rather than an existing one.

You could then update/append from that table to the 'real' tables in the database.

As for not knowing field names, if the data is well structured, though not normalized, then that might not be a problem especially, as you've said, you know the field positions.

 

[Darren Bartrup]

I've managed it by updating the worksheet and saving it as a temporary copy - I insert the dates next to each team member name and give it a named range reference, TM1 - TM8. The number corresponds to the Key on the team member name collection so I can use this to look up the key field on the team members table and join this back to their work load.

My almost working code is - I just need to sort out the number of team members now. It thinks there's one more than there actually is.

Public Sub Main()

    ''''''''''''''''''
    'Excel variables '
    ''''''''''''''''''
    Dim vFile As Variant            'Full path to the Work Count spreadsheet.
    Dim oXLApp As Object            'Reference to Excel Application.
    Dim oXLWrkBk As Object          'Reference to workbook.
    Dim oXLWrkSht As Object         'Reference to worksheet.
    Dim oXLLastCell As Object       'Reference to last cell on worksheet.
    
    Dim x As Long                   'A general counter used in various places throughout the routine.
    Dim lTeamMember As Long         'Holds the count of team members in team.
    Dim colTeamMember As Collection 'Holds the names of team members in the team.
    Dim vTeamMember As Variant      'Holds individual team member names from colTeamMember.
    
    On Error GoTo ERROR_HANDLER


    ''''''''''''''''''''''''''''''''''''''''''''''
    'Ask for location of Work Count spreadsheet. '
    ''''''''''''''''''''''''''''''''''''''''''''''
    vFile = GetFile()
    
    Select Case GetExt(CStr(vFile))
    
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        'Only continue if the correct file type has been selected. '
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Case "xls", "xlsx", "xlsm"
            'TO DO: Check it's the correct Excel file.
            
            ''''''''''''''''''''''''''''''''''''''''''''''''''
            'Set or create a reference to visible Excel.     '
            'Open the report and set references to the data. '
            ''''''''''''''''''''''''''''''''''''''''''''''''''
            Set oXLApp = CreateXL(True)
            
            'oXLApp.Calculation = -4135 'xlManual 'TO DO: Get this working.
            Set oXLWrkBk = oXLApp.WorkBooks.Open(vFile)
            Set oXLWrkSht = oXLWrkBk.WorkSheets("Workflows")
            Set oXLLastCell = LastCell(oXLWrkSht)
            
            With oXLWrkSht
                
                ''''''''''''''''''''''''''''''''''''''''''
                'Create a named range for the team data. '
                ''''''''''''''''''''''''''''''''''''''''''
                .Range("B4:K" & oXLLastCell.Row).Name = "TeamData"
            
                lTeamMember = 1
                Set colTeamMember = New Collection
                For x = oXLLastCell.Column To 12 Step -3
                    
                    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                    'Copy the date from column B to the left of each team member. '
                    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                    .Columns(x - 2).insert Shift:=-4161 'xlToRight
                    .Columns(2).Copy Destination:=.Columns(x - 2)
                    
                    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                    'Create a named range for team member on worksheet and add name to collection. '
                    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                    .Range(.Cells(4, x - 2), .Cells(oXLLastCell.Row, x + 1)).Name = "TM" & lTeamMember
                    colTeamMember.Add CStr(.Cells(3, x - 1)), CStr(lTeamMember)
                    lTeamMember = lTeamMember + 1
                    
                Next x


            End With
            
            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            'Save the Excel file as a temporary file - leaving the original untouched. '
            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            vFile = Left(vFile, InStr(vFile, ".") - 1) & " TMP" & Mid(vFile, InStr(vFile, "."), Len(vFile))
            'TO DO: Save any version of Excel.
            oXLWrkBk.SaveAs _
                FileName:=vFile, _
                FileFormat:=56  'xlExcel8
            oXLWrkBk.Close False
            
            'Application.Calculation = -4105 xlAutomatic 'TO DO: Get this working.
            
            ''''''''''''''''''''''''''''''''''''''''''''''''
            'Empty the TeamData table and import new data. '
            ''''''''''''''''''''''''''''''''''''''''''''''''
            DoCmd.SetWarnings False
            DoCmd.RunSQL "DELETE * FROM tbl_TMP_TeamData"
            DoCmd.SetWarnings True
            
            DoCmd.TransferSpreadsheet TransferType:=acImport, _
                          SpreadsheetType:=acSpreadsheetTypeExcel12, _
                          TableName:="tbl_TMP_TeamData", _
                          FileName:=CStr(vFile), _
                          HasFieldNames:=True, _
                          Range:="TeamData"
                                                                    
            For x = 1 To lTeamMember - 1
            
                ''''''''''''''''''''''''''''''''''''''''''''''''''''''
                'Empty the TeamMemberData table and import new data. '
                ''''''''''''''''''''''''''''''''''''''''''''''''''''''
                DoCmd.SetWarnings False
                DoCmd.RunSQL "DELETE * FROM tbl_TMP_TeamMemberData"
                DoCmd.SetWarnings True
            
                DoCmd.TransferSpreadsheet TransferType:=acImport, _
                              SpreadsheetType:=acSpreadsheetTypeExcel12, _
                              TableName:="tbl_TMP_TeamMemberData", _
                              FileName:=CStr(vFile), _
                              HasFieldNames:=True, _
                              Range:="TM" & x
                              
                'TO DO: Normalise!
            
            Next x
            
            '''''''''''''''''''''''''''''
            'Delete the temporary file. '
            '''''''''''''''''''''''''''''
            Kill vFile
        
        Case Else
        
            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            'This line should never be reached, as the file filter '
            'only allows for Excel files to be selected.           '
            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            MsgBox "Please select an Excel file type.", vbCritical + vbOKOnly, "File Selection Error."
        
    End Select


    On Error GoTo 0
    Exit Sub


ERROR_HANDLER:
    Select Case Err.Number
        
        Case Else
            MsgBox "Error " & Err.Number & vbCr & _
                " (" & Err.Description & ") in procedure Main."
            Err.Clear
            Resume
    End Select
    
End Sub