Hi Everyone,
I am trying to import individual Excel spreadsheets into Access and then keep these spreadsheets as individual tables when importing them. I have found code at accessmvp to do so; however, I need to also move the worksheet to an "imported" file and remove the imported worksheet from the original file folder. I have previous code that will import and move files and I have tried combining the "copy and move code" with the accessmvp import code and am having some issues. I am now getting a warning for a "Compile error: Expected Array" at the "StrFileList(intWorkbookCounter) = StrFile" line below. Am I on the right track with this code? If so, how do I get rid of the error?
Any help would be much appreciated! Please let me know if you would like me to clarify something.
Thanks for your time!
I am trying to import individual Excel spreadsheets into Access and then keep these spreadsheets as individual tables when importing them. I have found code at accessmvp to do so; however, I need to also move the worksheet to an "imported" file and remove the imported worksheet from the original file folder. I have previous code that will import and move files and I have tried combining the "copy and move code" with the accessmvp import code and am having some issues. I am now getting a warning for a "Compile error: Expected Array" at the "StrFileList(intWorkbookCounter) = StrFile" line below. Am I on the right track with this code? If so, how do I get rid of the error?
Any help would be much appreciated! Please let me know if you would like me to clarify something.
Thanks for your time!
Code:
Option Compare Database
Function Impt_Sero()
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 strcNewPath As String
Dim strPassword As String
Dim StrFileList As String
Dim Strfullpath As String
Dim strfullnewpath 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 = False
' Replace C:\MyFolder\ with the actual path to the folder that holds the EXCEL files
strPath = "C:\Users\wers\Desktop\Sero_Res\"
'New file pathway
'Make sure file pathway has a backslash
strcNewPath = "C:\Users\wers\Desktop\Imported_Sero\"
' Replace passwordtext with the real password;
' if there is no password, replace it with vbNullString constant
' (e.g., strPassword = vbNullString)
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
' 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, _
"tbl" & colWorksheets(lngCount) & intWorkbookCounter, _
strPath & StrFile, blnHasFieldNames, _
colWorksheets(lngCount) & "$"
Next lngCount
' Delete the collection
Set colWorksheets = Nothing
'Add file list so know which files to move
StrFileList(intWorkbookCounter) = StrFile
'Initialise paths:
Strfullpath = strPath & StrFileList(intWorkbookCounter)
strfullnewpath = strNewPath & StrFileList(intWorkbookCounter)
'Copy file to new location:
FileCopy Strfullpath, strfullnewpath
Loop
If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing
End Function