Import Excel to Access

[EndersG]

I would like to be able to PROGRAMATICALLY import an Excel worksheet into a database and append it to a table. Simple, right? Just one caveat. I would like to ensure that during the import process the values of the Excel worksheet are consistent with the design of the table structure that upholds data integrity (i.e. data types, field size limitations, validation rules, relationships, etc...). If not, then abort the import. In other words, if the entire import process is not successful (i.e., it produces one or more errors), I want to be able to rollback the entire update. ALL or NOTHING! And I want to be able to do this PROGRAMATICALLY (VBA code). If possible, I would like to be able to capture any error codes/messages so I can provide the user with constructive help information.

 

[mr moe]

I"m sure that this can be done, does anyone have a sample database for this purpose, if so could you please post it. Thanks.

 

[Daveswanton77]

Use this code to import a file called Import.xls or whatever you want to call it by changing the Const value on the third row of code. The file is placed in the same directory as the database, it is then processed and placed into an Archived directory called Archived Imports in the database's directory.

References are need to Scripting Runtime and the Microsoft Office Object libraries.

What the code does is to find the specified file, creates a temporary table using the structure of the main table as a template imports the data into that table. If the structure of the import file is not the same as the table the routine will stop and give an error notice. If it succeeds the data will then be appended to the main table and the file archived.

Option Compare Database
Option Explicit
Const ExcelImp = "Import.xls"

'------------------------------------------------------------------------------
' Procedure: subImport
' Author: Dave Swanton
' Purpose: Read in new data from an excel file
' Dependencies: None
' Parameters: None
'-------------------------------------------------------------------------------

' Notes
' Assumptions: 1) The filename to read is in the Const ExcelFile above
' 2) The file will be in the current database path
' 3) The file will be in the specified/agreed format

Public Sub subImport()
On Error GoTo Err_subImport

Dim stDocName As String
Dim fs As FileSearch
Dim ifn As String
Dim sql As String
Dim today As String
Dim fso As Scripting.FileSystemObject
Dim oktogo As Boolean
Dim specname As String
Dim repdate As String
Dim myfile As Scripting.TextStream
Dim i As Long
Dim y As Integer

DoCmd.SetWarnings False
oktogo = False


'Find the file for import


ifn = CurrentProject.Path & "\" & ExcelImp 'Path of Import.xls file

Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(ifn) Then
oktogo = True
Else
MsgBox "Please ensure that the source file is present and try again" & vbCr _
& "Required file and location: " & vbCr & ifn, vbExclamation + vbOKOnly, "Input File Missing"
End If

If oktogo Then




sql = "SELECT tbl_import.* INTO tbl_temp_import " _
& "FROM tbl_import "



DoCmd.RunSQL sql 'Create a temp table based on the structure of the main table to import into to check consistency

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "tbl_temp_import", ifn, True 'Import file into table


sql = "INSERT INTO tbl_import " _
& "SELECT tbl_temp_import.* " _
& "FROM tbl_temp_IntellectImport "


DoCmd.RunSQL sql 'Insert into main table




subArchiveImport ifn 'Archive the report

'MsgBox "Import Complete.", vbInformation + vbOKOnly + vbApplicationModal 'Info message





End If

Exit_subImport:
' Turn warning messages back on
DoCmd.SetWarnings True
Exit Sub

Err_subImport:
MsgBox Err.Description
Resume Exit_subImport

End Sub


'------------------------------------------------------------------------------
' Procedure: subArchiveIntell
' Author: Dave Swanton
' Purpose: Archive Intellect Import into Archived Intellect Folder
' Dependencies: None
' Parameters: None
'-------------------------------------------------------------------------------


Public Sub subArchiveImport(src As String)

On Error GoTo Err_subArchiveImport
Dim dest As String
Dim today As String

today = Format(Date, "dd-mm-yyyy")
dest = Left(src, InStrRev(src, "\")) & "Archived Imports\" & today & " - " & Right(src, Len(src) - InStrRev(src, "\"))
Name src As dest

Exit_subArchiveImport:
Exit Sub

Err_subArchiveImport:
MsgBox Err.Description
Resume Exit_subArchiveImport

End Sub