Import and Move File Code

moscgama

Registered User.
Local time
Yesterday, 20:21
Joined
Feb 10, 2014
Messages
28
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!

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
 
If you're on right track, I don't know, but to get rid of the error then Declare "StrFileList" as an Array and not as a "simple" string variable as you have done, (Dim StrFileList As String).
On the other side, I can't see why it should be an Array, so instead of:
Code:
StrFileList(intWorkbookCounter) = StrFile
Try chancing it to, in all places where it occur:
Code:
StrFileList = StrFile
 
Hi JHB,

Thanks so much for the response! Unfortunately, it didn't work and created an infinite loop. While I would like to be efficient and succinct as possible with my code, I am in a little bit of a time crunch. Instead, I am going to separate out the copy, move, and delete steps into another module. Hopefully, this code will be more my speed! :)

Thanks again for the help! I really appreciate it!!
 

Users who are viewing this thread

Back
Top Bottom