Darren Bartrup
Well-known Member
- Joined
- Mar 13, 2006
- Messages
- 1,297
- Office Version
- 365
- Platform
- Windows
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.
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.
Any help & pointers are greatly appreciated.
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.
Rich (BB code):
oXLApp.union(.Range(.Cells(4, 2), .Cells(oXLLastCell.row, 2)), .Range(.Cells(4, x), .Cells(oXLLastCell.row, x + 2))).Name = "TM" & lTeamMember
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.
Rich (BB code):
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.