Macro to import excel into a new table

[NL111]

Does anyone know how to do this? I Need to make a macro that will import all excel documents in a folder into a database, with the name of the table as the value in 1 of the boxes inside the excel document (So maybe A3 location).

Please help. Thanks!

 

[AccessMSSQL]

This isn't a simple task if you don't know VBA. You would need to do it through VBA. Also, if the data in each spreadsheet isn't clean you will end up with import errors. Are all of the spreadsheets the exact same format?

 

[AccessMSSQL]

Sounds like you also need to use the Excel Object library if you are trying to name the table the same as the value in cell A3. You would have to open each excel file seperately through code, read cell A3, create a new table with all of the appropriate fields and field types and then read rows from the excel file into the new table. This would all have to be written in code. I may have some examples to post shortly.

 

[AccessMSSQL]

Here is some code that might get you started - create a new module called modExcel and copy this code into it - make sure you don't duplicate the Option Compare Database statement.

Option Compare Database
Option Explicit
 
 
Private Sub CheckFolder()
'this loops through the excel directory and gets each file
   Dim fdr As String
   Dim sPath As String
   Dim sFile As String
   sPath = "C:\openxmltest\" 'change this to your path
   fdr = Dir(sPath)
   Do While fdr <> ""
        sFile = sPath & fdr
        ProcessExcelFile (sFile) 'this opens the file - finds cell A3 and creates a new table
   fdr = Dir
   Loop
 
End Sub
 
 
Public Sub CreateTableDef(strTableName As String) 'this creates a new table definition in access based on your fields
Dim tbl As DAO.TableDef
Dim fld As New DAO.Field
Dim rs As DAO.Recordset
Dim strSQL As String
Set tbl = CurrentDb.CreateTableDef(strTableName)
Set fld = tbl.CreateField("Field1", dbText, 100)
Set fld = tbl.CreateField("Field1", dbText, 100) 
 
'you need to create your own fields here that match up with the columns 
'in your excel spreadsheet - 
'assuming all the spreadsheets have the same columns
 
Set fld = tbl.CreateField("Field3", dbText, 100)
'see [URL]http://allenbrowne.com/ser-49.html[/URL] for more field type references
tbl.Fields.Append fld
CurrentDb.TableDefs.Append tbl
CurrentDb.TableDefs.Refresh
End Sub
 
 
Public Sub ProcessExcelFile(sFile As String)
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim sA3Val As String
Dim fieldArray() As String
On Error Resume Next
Set objXL = GetObject(, "Excel.Application")
If Err.Number > 0 Then  'Excel was not open
    Set objXL = New Excel.Application
End If
objXL.Visible = False
Set objWkb = objXL.Workbooks.Open(sFile)
    With objXL
        With objSht
            'get value of cell A3
            sA3Val = .Range("A3").Value
            CreateTableDef (sA3Val)
            'do some code to read the rest of the cell values for each row and insert into the new table
        End With
   End With 'End objXL
objXL.Quit
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
End Sub

hope this gets you started.

 

[NL111]

@AccessMSSQL: Sorry but I just realized that the names of the tables will be the name of the excel documents, as the value inside that A3 box is the name of the Excel document.
All the files have the same layout, Row 1 is the labels.

I mostly just need a way for VBA to use all the excel documents in a folder, so .xls and use those to make the different tables, with VBA reading the names of the documents and using that as the names of the tables.

Thank you very much for your help

 

[AccessMSSQL]

Are you trying to just create a link to the actual excel files so you can open the excel document within Access or are you trying to actually create a new table in Access with the name of the document?

 

[NL111]

I am trying to create a new table in Access with the name of the document. And inside the tables are the content of the excel files. Maybe if there is a box that let me choose the folder that will be great.
Thank you.

 

[AccessMSSQL]

The vba code that I provided has everything you need. Please see highlights in red. I did modify the ProcessFile and CreateTableDef procedures so i passes your filename to create the table instead of cell A3. You will have to write some code on your own to create the table fields and then insert the data from excel.

Option Compare Database
Option Explicit
 
 
Private Sub CheckFolder()
[COLOR=red]'this loops through the excel directory and gets each file[/COLOR]
   Dim fdr As String
   Dim sPath As String
   Dim sFile As String
   sPath = "C:\openxmltest\" [COLOR=red]'change this to your path[/COLOR]
   fdr = Dir(sPath)
   Do While fdr <> ""
        sFile = sPath & fdr
        ProcessExcelFile (sFile, fdr) 'this opens the file - finds cell A3 and creates a new table
   fdr = Dir
   Loop
 
End Sub
 
 
Public Sub CreateTableDef(strTableName As String) [COLOR=red]'this creates a new table definition in access based on your fields[/COLOR]
Dim tbl As DAO.TableDef
Dim fld As New DAO.Field
Dim rs As DAO.Recordset
Dim strSQL As String
Set tbl = CurrentDb.CreateTableDef(strTableName)
Set fld = tbl.CreateField("Field1", dbText, 100)
Set fld = tbl.CreateField("Field1", dbText, 100) 
 
'you need to create your own fields here that match up with the columns 
'in your excel spreadsheet - 
'assuming all the spreadsheets have the same columns
 
Set fld = tbl.CreateField("Field3", dbText, 100)
'see [URL="http://allenbrowne.com/ser-49.html"][COLOR=#0066cc]http://allenbrowne.com/ser-49.html[/COLOR][/URL] for more field type references
tbl.Fields.Append fld
CurrentDb.TableDefs.Append tbl
CurrentDb.TableDefs.Refresh
End Sub
 
 
Public Sub ProcessExcelFile(sFile As String, sFileName as String)
'sFile is the full path of the file, sFileName is just the filename
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim sA3Val As String
Dim fieldArray() As String
On Error Resume Next
Set objXL = GetObject(, "Excel.Application")
If Err.Number > 0 Then  'Excel was not open
    Set objXL = New Excel.Application
End If
objXL.Visible = False
Set objWkb = objXL.Workbooks.Open(sFile)
    With objXL
        With objSht
          [COLOR=red]  'create table with excel filename[/COLOR]
            sFileName = Replace(sFileName,".xls","") [COLOR=red]' removes xls from filename[/COLOR]
            CreateTableDef (sFileName)
           [COLOR=red] 'do some code to read the rest of the cell values for each row and insert into the new table[/COLOR]
        End With
   End With 'End objXL
objXL.Quit
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
End Sub

Another thing you might want to look at is Docmd.TransferText. May be a quicker solution for you.

http://www.dbforums.com/microsoft-access/1612459-import-excel-files.html

 

[NL111]

Is there anyway for me to use DoCmd.TransferSpreadsheet? I have been trying that since it seemed a bit simpler but I still need to makeit find all the excel files, and use it as table names, and then make the names of the files as names of the tables.

 

[NL111]

Does anyone know :O?

 

[AccessMSSQL]

NL11 - you can use docmd.transferspreadsheet but embed it within the loop that reads files from the folder in the excel directory. You can just modify my code:

[COLOR=red][COLOR=#000000]Public Sub ProcessExcelFile(sFile As String, sFileName as String)[/COLOR]
[COLOR=red]'sFile is the full path of the file, sFileName is just the filename[/COLOR]
[COLOR=black]Dim objXL As Excel.Application[/COLOR]
[COLOR=black]Dim objWkb As Excel.Workbook[/COLOR]
[COLOR=black]Dim objSht As Excel.Worksheet[/COLOR]
[COLOR=black]Dim sA3Val As String[/COLOR]
[COLOR=black]Dim fieldArray() As String[/COLOR]
[COLOR=black]On Error Resume Next[/COLOR]
[COLOR=black]Set objXL = GetObject(, "Excel.Application")[/COLOR]
[COLOR=black]If Err.Number > 0 Then  'Excel was not open[/COLOR]
[COLOR=black]  Set objXL = New Excel.Application[/COLOR]
[COLOR=black]End If[/COLOR]
[COLOR=black]objXL.Visible = False[/COLOR]
[COLOR=black]Set objWkb = objXL.Workbooks.Open(sFile)[/COLOR]
[COLOR=black]  With objXL[/COLOR]
[COLOR=black]      With objSht[/COLOR]
[COLOR=black]'create table with excel filename[/COLOR]
[COLOR=#000000]          sFileName = Replace(sFileName,".xls","") [/COLOR][COLOR=red]' removes xls from filename[/COLOR]
[COLOR=#000000]          CreateTableDef (sFileName)[/COLOR]
[COLOR=red]            'added this line[/COLOR]
            [COLOR=black]DoCmd.TransferSpreadsheet acImport, acspreadsheetExcel12, sFileName, sFile[/COLOR]
[COLOR=#000000]      End With[/COLOR]
[COLOR=#000000] End With 'End objXL[/COLOR]
[COLOR=#000000]objXL.Quit[/COLOR]
[COLOR=#000000]Set objSht = Nothing[/COLOR]
[COLOR=#000000]Set objWkb = Nothing[/COLOR]
[COLOR=#000000]Set objXL = Nothing[/COLOR]
[COLOR=#000000]End Sub[/COLOR][/COLOR]
        End With
   End With 'End objXL
objXL.Quit
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
End Sub

You still need the other functions. This way, you are reading the excel filename, creating the table, and then importing the file into the newly created table.