I get an excel workbook everyweek that has 7 sheets on it. The person that sends the file puts the name of the sheet and the date range (i.e. OutPatient 01-01-2011 - 01-08-2011) when I import this into access it creates a table based on the sheet name. I want to append the data so I need to format the sheet names to strip off the date. I tried using the left function however the sheet names without the date are of various lengths so i need to be able to trim the date of based on the actual sheet name.
Here is the code that I am using for the import. It aint pretty but it works.....except for the sheet name issue.
Public Function GetData()
Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
Dim intWorkbookCounter As Integer
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPath As String, strFile As String
Dim strPassword As String
' Establish an EXCEL application object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set objExcel = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0
' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = True
' Replace C:\MyFolder\ with the actual path to the folder that holds the EXCEL files
strPath = "C:\test\processed\"
' Replace passwordtext with the real password;
' if there is no password, replace it with vbNullString constant
' (e.g., strPassword = vbNullString)
' strPassword = "passwordtext"
strPassword = vbNullString
blnReadOnly = True ' open EXCEL file in read-only mode
strFile = Dir(strPath & "*.xls")
intWorkbookCounter = 0
Do While strFile <> ""
'intWorkbookCounter = intWorkbookCounter + 1
Set colWorksheets = New Collection
Set objWorkbook = objExcel.Workbooks.Open(strPath & strFile, , _
blnReadOnly, , strPassword)
For lngCount = 1 To objWorkbook.Worksheets.Count
colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
Next lngCount
'For lngCount = 0 To objWorkbook.Worksheets.Count
'With objWorkbook.Worksheets(1)
' .Rows("1:1").EntireRow.Delete
' End With
' Next lngCount
' Close the EXCEL file without saving the file, and clean up the EXCEL objects
objWorkbook.Close False
Set objWorkbook = Nothing
' Import the data from each worksheet into a separate table
For lngCount = colWorksheets.Count To 1 Step -1
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
Left(colWorksheets(lngCount), 15), _
strPath & strFile, blnHasFieldNames, _
colWorksheets(lngCount) & "$"
Next lngCount
' Delete the collection
Set colWorksheets = Nothing
' Uncomment out the next code step if you want to delete the
' EXCEL file after it's been imported
' Kill strPath & strFile
strFile = Dir()
Loop
If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing
Here is the code that I am using for the import. It aint pretty but it works.....except for the sheet name issue.
Public Function GetData()
Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
Dim intWorkbookCounter As Integer
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPath As String, strFile As String
Dim strPassword As String
' Establish an EXCEL application object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set objExcel = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0
' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = True
' Replace C:\MyFolder\ with the actual path to the folder that holds the EXCEL files
strPath = "C:\test\processed\"
' Replace passwordtext with the real password;
' if there is no password, replace it with vbNullString constant
' (e.g., strPassword = vbNullString)
' strPassword = "passwordtext"
strPassword = vbNullString
blnReadOnly = True ' open EXCEL file in read-only mode
strFile = Dir(strPath & "*.xls")
intWorkbookCounter = 0
Do While strFile <> ""
'intWorkbookCounter = intWorkbookCounter + 1
Set colWorksheets = New Collection
Set objWorkbook = objExcel.Workbooks.Open(strPath & strFile, , _
blnReadOnly, , strPassword)
For lngCount = 1 To objWorkbook.Worksheets.Count
colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
Next lngCount
'For lngCount = 0 To objWorkbook.Worksheets.Count
'With objWorkbook.Worksheets(1)
' .Rows("1:1").EntireRow.Delete
' End With
' Next lngCount
' Close the EXCEL file without saving the file, and clean up the EXCEL objects
objWorkbook.Close False
Set objWorkbook = Nothing
' Import the data from each worksheet into a separate table
For lngCount = colWorksheets.Count To 1 Step -1
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
Left(colWorksheets(lngCount), 15), _
strPath & strFile, blnHasFieldNames, _
colWorksheets(lngCount) & "$"
Next lngCount
' Delete the collection
Set colWorksheets = Nothing
' Uncomment out the next code step if you want to delete the
' EXCEL file after it's been imported
' Kill strPath & strFile
strFile = Dir()
Loop
If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing
