Excel cells to Access tables - help

[thadson]

Hi,

I'm trying to import specific cells from MS Excel 2000 spreadsheets to MS Access 2000 tables then move the spreadsheets to a different directory.
I'm very new to this and I'm having trouble to implement this.

I have worked out so far the code to import certain cells into 1 table, but I do not know how to import some other cells into another tables so the data would be connected and remain together.

So lets say that I have 2 tables named tblXls and tblXls2 in and Access 2000 Database and I want to import cells F2, C2 and J2 from excel spreadsheets into the fields Test, Test2 and Test3 in the table tblXls, and then I want to import cell F3, C3 and J3 into the fields Name, Phone, and Address in the tblXls2 table. How do I do this?

Here is the code I have so far for the 1 table:

Private Sub xlsAdd_Click()
 
Dim rec As DAO.Recordset
Dim xls As Object
Dim xlsSht As Object
Dim xlsSht2 As Object
Dim xlsWrkBk As Object
Dim xlsPath As String
Dim xlsPath2 As String
Dim xlsFile As String
Dim fullXlsFile As String
Dim fullFile As String
Dim fullFile2 As String
 
Dim Msg, Style, title, Response
  Msg = "Importing is Done, Files are imported!"    ' Define message.
  Style = vbOKOnly
  title = "Import Mesage"
 
    xlsPath = "C:\Xls\"    ' Set the xls path for new files.
    xlsPath2 = "C:\Xls\done\"    ' Set the 2nd xls path to store imported files.
    xlsFile = Dir(xlsPath & "*.xls", vbNormal)     ' Retrieve the first entry.
    
    Do While xlsFile <> ""    ' Start the loop.
        ' Ignore the current directory and the encompassing directory.
        fullXlsFile = xlsPath & xlsFile
        fullFile = xlsPath & xlsFile
        fullFile2 = xlsPath2 & xlsFile
        If Right(fullXlsFile, 4) = ".xls" Then 'import it
        DoCmd.SetWarnings False
        Set xls = CreateObject("Excel.Application")
        Set xlsWrkBk = GetObject(fullXlsFile)
        Set xlsSht = xlsWrkBk.Worksheets(1)
        Set xlsSht2 = xlsWrkBk.Worksheets(2)
                
        'Open 1st table
        Set rec = CurrentDb.OpenRecordset("tblXls")
        rec.AddNew
        rec.Fields("Test") = Nz(StrConv(xlsSht.cells(2, "F"), vbProperCase), "bad1")
        rec.Fields("Test2") = Nz(StrConv(xlsSht.cells(2, "C"), vbProperCase), "bad2")
        rec.Fields("Test3") = Nz(StrConv(xlsSht.cells(2, "J"), vbProperCase), "0001110000")
        rec.Fields("Test4") = Left(xlsFile, 10)
        rec.Update
        
        'How do I open the second table here to continue exportind the rest of the data?
        
        DoCmd.SetWarnings True
        End If
        
        'Closing excel
        xlsWrkBk.Application.Quit
    
    'Moving the imported Excel file
    Name fullFile As fullFile2
    xlsFile = Dir()
        
    Loop
Response = MsgBox(Msg, Style, title)
End Sub

Please Help. Thanks.

 

[MStef]

Look at "DemoImportXLSA2000.zip".
there you have got a XLS spreadsheet "TblXls1" and Access MDB "DemoImportXLSA2000.mdb".
In MDB you have got a link tbl "TblXls1" (on XLS spreadheet).
IMPORTANT: Make a relink of this tbl (your path name).

In MDB you have got a "Query1ImprtXls" (make table query).
Run this query, and you are going to have a table "tblXlsAccess".

I think it can help you.

 

[thadson]

Thank you MStef for the reply. I appreciate it.
However it will not solve my problem.
I have over 500 spreadsheets that need to be imported. I wrote the vba code to loop the import and then to move the imported files.
It already has the ability to import data into 1 table from them. What I need is a way to import all the data into the separate tables not only 1 table.
I have changed your example spreadsheet and I added the tables to the DB, just so you can see what I'm trying to deal with, except there are 500 of them and all needs to be imported. I do not want to do this manually. (the real spreadsheet has about a 100 fields spread into 10 tables.) I will include the changed code for this example as well. Thank you.

Private Sub xlsAdd_Click()
 
Dim rec As DAO.Recordset
Dim xls As Object
Dim xlsSht As Object
Dim xlsSht2 As Object
Dim xlsWrkBk As Object
Dim xlsPath As String
Dim xlsPath2 As String
Dim xlsFile As String
Dim fullXlsFile As String
Dim fullFile As String
Dim fullFile2 As String
 
Dim Msg, Style, title, Response
  Msg = "Importing is Done, Files are imported!"    ' Define message.
  Style = vbOKOnly
  title = "Import Mesage"
 
    xlsPath = "C:\Xls\"    ' Set the xls path for new files.
    xlsPath2 = "C:\Xls\done\"    ' Set the 2nd xls path to store imported files.
    xlsFile = Dir(xlsPath & "*.xls", vbNormal)     ' Retrieve the first entry.
    
    Do While xlsFile <> ""    ' Start the loop.
        ' Ignore the current directory and the encompassing directory.
        fullXlsFile = xlsPath & xlsFile
        fullFile = xlsPath & xlsFile
        fullFile2 = xlsPath2 & xlsFile
        If Right(fullXlsFile, 4) = ".xls" Then 'import it
        DoCmd.SetWarnings False
        Set xls = CreateObject("Excel.Application")
        Set xlsWrkBk = GetObject(fullXlsFile)
        Set xlsSht = xlsWrkBk.Worksheets(1) 'worksheet List1 of TblXls1.xls
        Set xlsSht2 = xlsWrkBk.Worksheets(2) 'worksheet List2 of TblXls1.xls
                
        'Open 1st table
        Set rec = CurrentDb.OpenRecordset("Table1")
        rec.AddNew
        rec.Fields("Data1") = Nz(StrConv(xlsSht.cells(1, "B"), vbProperCase), "bad1")
        rec.Fields("Data2") = Nz(StrConv(xlsSht.cells(3, "B"), vbProperCase), "bad2")
        rec.Fields("Data4") = Nz(StrConv(xlsSht2.cells(1, "B"), vbProperCase), "0001110000")
        rec.Fields("Data25") = Left(xlsFile, 10) 'first 10 charactes of filename
        rec.Update
        
        'How do I open the second and third tables here to continue exporting the rest of the data?
        'example: cell F3 of worksheet List1 of TblXls1.xls should import to Table2
        'example2: cell F2 of worksheet List2 of TblXls1.xls should import goes to Table3
   
        
        DoCmd.SetWarnings True
        End If
        
        'Closing excel
        xlsWrkBk.Application.Quit
    
    'Moving the imported Excel file
    Name fullFile As fullFile2
    xlsFile = Dir()
        
    Loop
Response = MsgBox(Msg, Style, title)
End Sub