Error when importing multiple data tabs leads to VBA corruption

[luka731]

I have a simple import macro that I use to pull in multiple spreadsheet tabs into Access in order to feed a PowerPivot connection. The macro has begun to crash at certain points, with the error "The Search Key was not found in any record"

When I check the spreadsheet, the tab that crashes the macro exists, spelling matches the VBA code, etc. When I receive this error, it seems to be the kiss of death for the database. The database crashes, I go through a repeated cycle of dialog boxes, and then ultimately one that states that the VBA code is corrupt and must be deleted. I then have to restore the database to a previous version, and then start the import over from the beginning.

Below is the VBA code to import the tabs. Any thoughts/help are greatly appreciated, as the import process takes approx 10min to complete. When it fails, i have to go back to the beginning and restart. This issue just started occurring within the last two months; previously this issue was not present and the files were imported successfully in one attempt.

Function ImportallExcel()

Dim myfile
Dim mypath
mypath = "R:\Physician Finance\PO Reports\Monthly\Dashboards\Source Files\"

'DeleteTables

Do
myfile = Dir(mypath & "Data Dumps.xlsx")

'this will import ALL the excel files (one at a time, but automatically) in this folder. Make sure that's what you want.
DoCmd.TransferSpreadsheet acImport, 8, "Entity Mapping", mypath & myfile, True, "Entity Mapping$"
DoCmd.TransferSpreadsheet acImport, 8, "CA Practice Mapping", mypath & myfile, True, "CA Practice Mapping$"
DoCmd.TransferSpreadsheet acImport, 8, "WPAON", mypath & myfile, True, "WPAON$"
DoCmd.TransferSpreadsheet acImport, 8, "Anesthesia", mypath & myfile, True, "Anesthesia$"
DoCmd.TransferSpreadsheet acImport, 8, "Epic", mypath & myfile, True, "Epic$"
DoCmd.TransferSpreadsheet acImport, 8, "Manual", mypath & myfile, True, "Manual$"
DoCmd.TransferSpreadsheet acImport, 8, "Employee Master", mypath & myfile, True, "Employee Master$"
DoCmd.TransferSpreadsheet acImport, 8, "Care Alignment", mypath & myfile, True, "Care Alignment$"
DoCmd.TransferSpreadsheet acImport, 8, "Lag Days", mypath & myfile, True, "Lag Days$"
DoCmd.TransferSpreadsheet acImport, 8, "Scheduling", mypath & myfile, True, "Scheduling$"
DoCmd.TransferSpreadsheet acImport, 8, "Epic Scheduling", mypath & myfile, True, "Epic Scheduling$"
DoCmd.TransferSpreadsheet acImport, 8, "Epic BA Map", mypath & myfile, True, "Epic BA Map$"
DoCmd.TransferSpreadsheet acImport, 8, "Supervising Practices", mypath & myfile, True, "Supervising Practices$"
DoCmd.TransferSpreadsheet acImport, 8, "GL Reserves", mypath & myfile, True, "GL Reserves$"
DoCmd.TransferSpreadsheet acImport, 8, "GL 2014 Act", mypath & myfile, True, "GL 2014 Act$"
DoCmd.TransferSpreadsheet acImport, 8, "GL 2015 Act", mypath & myfile, True, "GL 2015 Act$"
DoCmd.TransferSpreadsheet acImport, 8, "GL 2014 Bud", mypath & myfile, True, "GL 2014 Bud$"
DoCmd.TransferSpreadsheet acImport, 8, "GL 2015 Bud", mypath & myfile, True, "GL 2015 Bud$"
DoCmd.TransferSpreadsheet acImport, 8, "CPT Procedures", mypath & myfile, True, "CPT Procedures$"
DoCmd.TransferSpreadsheet acImport, 8, "Athena CC Mapping", mypath & myfile, True, "Athena CC Mapping$"
DoCmd.TransferSpreadsheet acImport, 8, "PO Lookup", mypath & myfile, True, "PO Lookup$"
DoCmd.TransferSpreadsheet acImport, 8, "Period End", mypath & myfile, True, "Period End$"
DoCmd.TransferSpreadsheet acImport, 8, "wRVU Budget", mypath & myfile, True, "wRVU Chgs Pmts Budget$"
DoCmd.TransferSpreadsheet acImport, 8, "Epic Provider Type", mypath & myfile, True, "Epic Provider Type$"
DoCmd.TransferSpreadsheet acImport, 8, "Denials", mypath & myfile, True, "Denials$"
DoCmd.TransferSpreadsheet acImport, 8, "Epic CPT Procedures", mypath & myfile, True, "Epic CPT Procedures$"
myfile = Dir
Loop Until myfile = ""

End Function

 

[ranman256]

get rid of the DO LOOP...you dont need it.
and you have double dip on mypath...
corrected below:

Function ImportallExcel()


Dim myfile
Dim mypath
mypath = "R:\Physician Finance\PO Reports\Monthly\Dashboards\Source Files\"

'DeleteTables

myfile = myPath & "Data Dumps.xlsx"

   'this will import ALL the excel files (one at a time, but automatically) in this folder. Make sure that's what you want.
DoCmd.TransferSpreadsheet acImport, 8, "Entity Mapping", myFile, True, "Entity Mapping$"
DoCmd.TransferSpreadsheet acImport, 8, "CA Practice Mapping", myFile, True, "CA Practice Mapping$"
DoCmd.TransferSpreadsheet acImport, 8, "WPAON", myFile, True, "WPAON$"
DoCmd.TransferSpreadsheet acImport, 8, "Anesthesia", myFile, True, "Anesthesia$"
DoCmd.TransferSpreadsheet acImport, 8, "Epic", myFile, True, "Epic$"
DoCmd.TransferSpreadsheet acImport, 8, "Manual", myFile, True, "Manual$"
DoCmd.TransferSpreadsheet acImport, 8, "Employee Master", myFile, True, "Employee Master$"
DoCmd.TransferSpreadsheet acImport, 8, "Care Alignment", myFile, True, "Care Alignment$"
DoCmd.TransferSpreadsheet acImport, 8, "Lag Days", myFile, True, "Lag Days$"
DoCmd.TransferSpreadsheet acImport, 8, "Scheduling", myFile, True, "Scheduling$"
DoCmd.TransferSpreadsheet acImport, 8, "Epic Scheduling", myFile, True, "Epic Scheduling$"
DoCmd.TransferSpreadsheet acImport, 8, "Epic BA Map", myFile, True, "Epic BA Map$"
DoCmd.TransferSpreadsheet acImport, 8, "Supervising Practices", myFile, True, "Supervising Practices$"
DoCmd.TransferSpreadsheet acImport, 8, "GL Reserves", myFile, True, "GL Reserves$"
DoCmd.TransferSpreadsheet acImport, 8, "GL 2014 Act", myFile, True, "GL 2014 Act$"
DoCmd.TransferSpreadsheet acImport, 8, "GL 2015 Act", myFile, True, "GL 2015 Act$"
DoCmd.TransferSpreadsheet acImport, 8, "GL 2014 Bud", myFile, True, "GL 2014 Bud$"
DoCmd.TransferSpreadsheet acImport, 8, "GL 2015 Bud", myFile, True, "GL 2015 Bud$"
DoCmd.TransferSpreadsheet acImport, 8, "CPT Procedures", myFile, True, "CPT Procedures$"
DoCmd.TransferSpreadsheet acImport, 8, "Athena CC Mapping", myFile, True, "Athena CC Mapping$"
DoCmd.TransferSpreadsheet acImport, 8, "PO Lookup", myFile, True, "PO Lookup$"
DoCmd.TransferSpreadsheet acImport, 8, "Period End", myFile, True, "Period End$"
DoCmd.TransferSpreadsheet acImport, 8, "wRVU Budget", myFile, True, "wRVU Chgs Pmts Budget$"
DoCmd.TransferSpreadsheet acImport, 8, "Epic Provider Type", myFile, True, "Epic Provider Type$"
DoCmd.TransferSpreadsheet acImport, 8, "Denials", myFile, True, "Denials$"
DoCmd.TransferSpreadsheet acImport, 8, "Epic CPT Procedures", myFile, True, "Epic CPT Procedures$"

End Function