asked on

MICROSOFT ACCESS 2007 - importing excel files into a table.

I have the following code to import excel files into access table. But it only inserts the first row of each file. I need it to insert all the rows of each column.

Public Function MYPREMLOAD()

Dim strPath As String
Dim appExcel As Excel.Application
Dim strFolderPath As String
Dim MyDB As DAO.Database
Dim MyRS As DAO.Recordset
Dim strSQL As String
  
DoCmd.SetWarnings False
  strSQL = "Delete * From tblCustomer;"
  DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
  
Set MyDB = CurrentDb()

Set MyRS = MyDB.OpenRecordset("tblCustomer", dbOpenDynaset)
  
'strFolderPath = "C:\Customers\"
'strPath = "C:\Customers\*.xls"     'Set the path.
  
strFolderPath = "X:\Special Risk\miketesting\POI\"
strPath = "X:\Special Risk\miketesting\POI\*.xls"
  
strPath = Dir(strPath, vbNormal)   'Retrieve the first entry.
Set appExcel = CreateObject("Excel.Application")
  
Do While strPath <> ""    'Initiate the loop
  appExcel.Workbooks.Open strFolderPath & strPath
  appExcel.Visible = True
  appExcel.Sheets("SR").Select
    With MyRS
      .AddNew
        !Policy = appExcel.Range("D2").Value
        !Effective = appExcel.Range("F2").Value
        !Yr = appExcel.Range("G2").Value
        !Premium = appExcel.Range("J2").Value
      .Update
    End With
  strPath = Dir           'Next entry
Loop
  
appExcel.Quit
Set appExcel = Nothing
  
MyRS.Close
Set MyRS = Nothing
  
MsgBox "This Process has completed!"
  

End Function

Open in new window

SiddharthRout

Try this

Const xlUp = -4162

Public Function MYPREMLOAD()
    Dim strPath As String, strFolderPath As String, strFolderPath As String
    Dim appExcel As Excel.Application
    Dim MyDB As DAO.Database, MyRS As DAO.Recordset
    Dim LastRow As Long
    
    DoCmd.SetWarnings False
    strSQL = "Delete * From tblCustomer;"
    DoCmd.RunSQL strSQL
    DoCmd.SetWarnings True
 
    Set MyDB = CurrentDb()
    
    Set MyRS = MyDB.OpenRecordset("tblCustomer", dbOpenDynaset)
     
    strFolderPath = "X:\Special Risk\miketesting\POI\"
    strPath = "X:\Special Risk\miketesting\POI\*.xls"
     
    strPath = Dir(strPath, vbNormal)
    Set appExcel = CreateObject("Excel.Application")
     
    Do While strPath <> ""
        appExcel.Workbooks.Open strFolderPath & strPath
        appExcel.Visible = True
        With MyRS
            LastRow = Sheets("SR").UsedRange.SpecialCells(xlCellTypeLastCell).Row
            
            For i = 2 To LastRow
                .AddNew
                !Policy = appExcel.Range("D" & i).Value
                !Effective = appExcel.Range("F" & i).Value
                !Yr = appExcel.Range("G" & i).Value
                !Premium = appExcel.Range("J" & i).Value
                .Update
            Next
            
        End With
        strPath = Dir
    Loop
     
    appExcel.Quit
    Set appExcel = Nothing
     
    MyRS.Close
    Set MyRS = Nothing
     
    MsgBox "This Process has completed!"
End Function

Open in new window

Sid

SiddharthRout

Replace line 1

Const xlUp = -4162

by

Const xlCellTypeLastCell = 11

Sid

centralmike

ASKER

Thanks the code works great. Just one addition question. What if I want to start reading the files at line 3 of all the worksheets. Is there away do accomplish that?

Thanks

Mike

ASKER CERTIFIED SOLUTION

SiddharthRout

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

centralmike

ASKER

Can column names be used instead of column letters? What if the policy is column "M" instead of column "D". Can you reference the name of column in stead of the letter?

Thanks again Mike

SiddharthRout

Yes

Col A - 1
Col B - 2

and so on...

So if you want to refer to Range("A1") then you can also say Cells(1,1) or if you want to refer to range("A2") the you can also refer to it as cells(2,1) where the syntax is

Cells(Row,Column)

Sid