Data Import Programatically

[khwaja]

I routinely import excel files into my DB and then update the contents of existing tables. To do this programatically, I used the following code. I am not very confident user of VB so would like some help in improving this. It works one time but next time it freezes. However, if I delete imported tables physically, it works again. So looks like I did not get it right in the first part dealing with deletion of temp tables.


Sub Monthlyroutine()
Dim dbs As Database, tdf As TableDef
Set dbs = CurrentDb

On Error GoTo Macro1_Err

DoCmd.SetWarnings False

'If tables exist, delete it.
For Each tdf In dbs.TableDefs
If tdf.Name = "tblDept1" Or tdfName = "Sale_Cust Data1" Or tdfName = "Region & Areas1" Then
dbs.TableDefs.Delete tdf.Name
End If
Next tdf

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel3, "tblDept1", "\\Nnorsogfas031\Design\99 AK Files\Zircon\Downloads\Departmental Sale.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel3, "Sale_Cust Data1", "\\Nnorsogfas031\Design\99 AK Files\Zircon\Downloads\Sales_Cust Data.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel3, "Region & Areas1", "\\Nnorsogfas031\Design\99 AK Files\Zircon\Downloads\Region & Areas.xls", True

' RunSQL executes a SQL string
DoCmd.RunSQL "DELETE FROM tblDepts;"
DoCmd.RunSQL "DELETE FROM [Region & Areas];"
DoCmd.RunSQL "DELETE FROM [Sale_Cust Data];"

dbs.Execute " INSERT INTO tblDepts SELECT * FROM [tblDept1];"
dbs.Execute " INSERT INTO [Sale_Cust Data] SELECT * FROM [Sale_Cust Data1];"
dbs.Execute " INSERT INTO [Region & Areas] SELECT * FROM [Region & Areas1];"

DoCmd.SetWarnings True
Set dbs = Nothing

MsgBox ("All Data updated")

Macro1_Exit:
Exit Sub

Macro1_Err:
MsgBox Error$
Resume Macro1_Exit

End Sub

 

[ajetrumpet]

i am not sure why it freezes, but I would try some of this stuff to help:



replace "currentdb.execute" with docmd.runSQL

replace the tabledefs loop with a docmd.deleteobject method and resume next command on any errors

put a REFRESHDATABASEWINDOW command after the tabledefs loop

put a DOEVENTS command after each one of your import commands to delay execution overlapping.



some of that might work, but don't hold me to it!

 

[DCrake]

Is there a reason why you cannot link the spreadsheets then use an append query from the spreadsheet to the table. Donlt understand why you create tables in the first place. Seems to me to be a totally redundant process. Simply delete the contants form the main tables tables then use the append query.

 

[khwaja]

Iwasn't very confident and just wanted to take small steps so broke it down to something I can see happening. You are right I should be able to simplify it. I tried but I could not quite achieve this. If I were to modify this code, would following work?

Sub Monthlyroutine()
Dim dbs As Database, tdf As TableDef
Set dbs = CurrentDb

On Error GoTo Macro1_Err

DoCmd.SetWarnings False

' RunSQL executes a SQL string
DoCmd.RunSQL "DELETE FROM tblDepts;"
DoCmd.RunSQL "DELETE FROM [Region & Areas];"
DoCmd.RunSQL "DELETE FROM [Sale_Cust Data];"

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel3, "tblDepts", "\\Nnorsogfas031\Design\99 AK Files\Zircon\Downloads\Departmental Sale.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel3, "Sale_Cust Data", "\\Nnorsogfas031\Design\99 AK Files\Zircon\Downloads\Sales_Cust Data.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel3, "Region & Areas", "\\Nnorsogfas031\Design\99 AK Files\Zircon\Downloads\Region & Areas.xls", True


DoCmd.SetWarnings True
Set dbs = Nothing

MsgBox ("All Data updated")

Macro1_Exit:
Exit Sub

Macro1_Err:
MsgBox Error$
Resume Macro1_Exit

End Sub

 

[DCrake]

First things first Make a back up of both front end and back end then try out your amendments, in theory it should work, but they're the famous last words.

 

[khwaja]

Thanks a lot for providing me the encouragement. It worked. I wasn't too sure of my own changes to the code.