import excel

  • Thread starter Thread starter R.Kisoenpersad
  • Start date Start date
R

R.Kisoenpersad

hi,
Have several excel files in a folder. want to import them all at once
(ofcource if it can automatically)

they all have 2 sheets (open and Closed)
they all have at line 6 the header (both sheets)
they all have data started at line 7 (both sheets)

how can I import these excel files into access?
Kisoen
 
Kisoen,
Below is a sample set of code which opens an excel file in
OfficXP, reads lines, puts data in an access table, then
closes the spreadsheet. To use it for your purposes you
could put some of the code in a loop which opens the table
recordset first, then loops through each spreadsheed
opening them and reading the data into the table, the
close everything and get out. I hope it helps.
Tom

Dim rst As Recordset
Dim intLineCounter As Integer
Dim intBlankCounter As Integer
Dim oApp As Excel.Application
Dim strCheck As String
Dim strSQL As String
' ctl_ImportFileName has the Excel spreadsheet file name
strCheck = Dir$(ctl_ImportFileName)
If strCheck = "" Then
MsgBox "Can't find file '" & ctl_ImportFileName _
& ".' Please check location of the file you wish " _
& "to import, and try again."
GoTo Exit_btn_CallsImport_Click
End If

' The following sets up the records set which will be
' added to.

strSQL = "Select * From tblCalls " _
& "Where callDate = #" & ctl_CallDate & "#"
DoCmd.SetWarnings False
DoCmd.Hourglass True

Set rst = CurrentDb.OpenRecordset(strSQL)
Set oApp = New Excel.Application
oApp.Workbooks.Open FileName:=ctl_ImportFileName
oApp.Visible = True
intLineCounter = 1
intBlankCounter = 0
Do Until intBlankCounter = 4
intLineCounter = intLineCounter + 1
oApp.Cells(intLineCounter, 1).Select
If oApp.Selection = "" Then
intBlankCounter = intBlankCounter + 1
GoTo NextLoop
End If
' The blank counter allows me to loop till I have found
' 3 blank lines in a row. You can change this logic
' to be from line to line, whatever works for you.
intBlankCounter = 0
If Not IsDate(oApp.Selection) Then GoTo NextLoop
rst.AddNew
rst!callDate = oApp.Cells(intLineCounter, 1)
rst!callTime = oApp.Cells(intLineCounter, 2)
rst!callState = oApp.Cells(intLineCounter, 3)
rst!callStation = oApp.Cells(intLineCounter, 5)
rst!callLogDate = ctl_LogDate
rst!callException = 0
rst.Update
NextLoop:
Loop

oApp.Quit
Set oApp = Nothing
rst.Close
Set rst = Nothing

Exit_btn_CallsImport_Click:
DoCmd.SetWarnings True
DoCmd.Hourglass False
Exit Sub

Err_btn_CallsImport_Click:
MsgBox Err.Number & "-" & Err.Description, vbCritical
Resume Exit_btn_CallsImport_Click
 
Back
Top