This is a import-Function for excel-data but you can find several examples
on the net.
Public Function TRANSimportTurnoverMonthYear(strSourceFile As String, iMonth
As Byte, iYear As Long) As Boolean
On Error GoTo errHandling
Dim iLoop, iCountDoubles As Integer
Dim iComID As Long
Dim bTransactionActive As Boolean
Dim objRsImport As ADODB.Recordset
Dim objRsDestination As ADODB.Recordset
' Function-succes-status
TRANSimportTurnoverMonthYear = False
'Set values
iCountDoubles = 0
Dim objConnSQL As ADODB.Connection
Set objConnSQL = CurrentProject.Connection
'Connect to datasource
Set objRsImport = New ADODB.Recordset
Dim objConnExcel As ADODB.Connection
Set objConnExcel = New ADODB.Connection
objConnExcel.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &
strSourceFile & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"""
objRsImport.Open "Select * from [Sheet1$]", objConnExcel,
adOpenForwardOnly, adLockReadOnly, adCmdText
DoCmd.Hourglass True
objRsImport.MoveFirst
'Open TargetTable
Set objRsDestination = New ADODB.Recordset
objRsDestination.Open "COMPANY_TURNOVER", objConnSQL, adOpenKeyset,
adLockOptimistic, adCmdTableDirect
'Start transaction
objConnSQL.BeginTrans
bTransactionActive = True
'MsgBox "start looping rows"
Do Until objRsImport.EOF
iComID = FindComIdFromVeroNr(CLng(objRsImport.Fields(0)))
If iComID = 0 Then
'No import: No matching company found FindCompanyNAME(
Else
If ExistsComTurnover(iComID, iYear, iMonth) Then
iCountDoubles = iCountDoubles + 1
gActionFailureText = gActionFailureText & "No import for
" & FindCompanyNAME(CurrentProject.Connection, iComID) & " (Ycomm_ID=" &
iComID & ") : value exists!" & vbCrLf
If iCountDoubles > 9 Then
gActionFailureText = "To many doubles. Check total
second import!"
End If
Else
With objRsDestination
.AddNew
.Fields("COMTURN_COM_ID").Value = iComID
.Fields("COMTURN_MONTH").Value = DateSerial(iYear,
iMonth, 1)
.Fields("COMTURN_LAST_UPDATE_DATE").Value = Date
.Fields("COMTURN_AMOUNT").Value =
objRsImport.Fields(2)
.Update
End With
End If
End If
objRsImport.MoveNext
Loop
'COMMIT OR ROLLBACK IMPORT
If objConnSQL.Errors.Count = 0 And Err.Number = 0 And iCountDoubles
< 10 Then
objConnSQL.CommitTrans
bTransactionActive = False
TRANSimportTurnoverMonthYear = True
If Len(gActionFailureText) > 0 Then gActionFailureText = vbCrLf
& "BUT" & vbCrLf & gActionFailureText
Else
objConnSQL.RollbackTrans
bTransactionActive = False
TRANSimportTurnoverMonthYear = False
End If
' Clear memory
objRsImport.Close
Set objRsImport = Nothing
objRsDestination.Close
Set objRsDestination = Nothing
objConnSQL.Close
Set objConnSQL = Nothing
objConnExcel.Close
Set objConnExcel = Nothing
'succes
DoCmd.Hourglass False
Exit Function
errHandling:
DoCmd.Hourglass False
If bTransactionActive Then objConnSQL.RollbackTrans
MsgBox Err.Number & " " & Err.Description
End Function
"John Marble" <fr******@gmail.com> wrote in message
news:28**************************@posting.google.c om...
I have around 400 excel files filled with data that I need to import
in ACCESS. The tricky part is that they must be imported one at time,
and properly corrected before importing the next one. I already
automated most of the formatting task of the raw data, and I am
wondering if it is possible to automate the original importation too
(like when I click on FILE>Import).
Anyone have an idea?