import each workbook in folder to access

[grogs84]

Hello Everyone,

I have a folder with ~2,500 workbooks that I am trying to import into Access. The files are named 10.xls, 11.xls, 12.xls ect...

When I run my macro it starts with 1000.xls and only imports about 25.

Any ideas on how to import all these?

sub automatic()
    Dim wbOpen As Workbook
    Dim wbNew As Workbook
    Const strPath As String = "C:\Documents and Settings\xxxxx\Desktop\importfolder\"
    Dim strExtension As String
 
'   turns off the 'save file alert'
    Application.DisplayAlerts = False
'   Changes drive to const strPath
    ChDir strPath
'   Change extension, looks for all extensions ending in .xls
    strExtension = Dir(" *.xls ")
 
    On Error Resume Next
 
        Do While strExtension <> ""
            Set wbOpen = Workbooks.Open(strPath & strExtension)
                With wbOpen
                     Call add_metrics
                End With
            ActiveWorkbook.Close
            strExtension = Dir
        Loop
 
End Sub
--------------------------------------------------------------------------------------
Sub add_metrics()
    Dim lastcell As Range
'  Application.DisplayAlerts = False
'   finds the last entry which we don't need
    Set lastcell = Range("a" & rows.Count).End(xlUp)
 
'   deletes the last entry
    lastcell.EntireRow.Delete
 
'   Rename column headings
    Range("a1").Resize(, 10) = Array("xxx"xxx", "xxx", "xxx" _
                                    , "xxx", "xxx", "xxx" _
                                    , "xxx", "xxx" _
                                    , "xxx")
'   rename sheet
    ActiveSheet.Name = "Sheet1"
 
 '  Saves the file to importsheet.xls on my desktop
    ChDir "C:\Documents and Settings\xxxxxx\Desktop"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Documents and Settings\xxxxx\Desktop\importsheet.xls", FileFormat:=xlExcel8 _
         , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
'   opens our database, runs the import
    Set appAccess = Access.Application
 
    appAccess.OpenCurrentDatabase "C:\Documents and Settings\xxxx\Desktop\New_Metrics.accdb"
    appAccess.Visible = False
    DoCmd.RunSavedImportExport ("importsheets")
 
    DoCmd.Quit
 
End Sub