There may be an easier way to do this but this is what I tested and it worked:
1. Create a table called IMPORTS in your access database
2. Create columns in that table that are labeled A through O
3. Set the data type of column A to date/time
5. Set the data type of all other columns to number (double is probably what you want for all of them but I don't know)
I created three test files each having one row of data on row 12, each having data exactly as wide as you show in your example spreadsheet.
I put these files in c:\ and incremented the date on each file so I could determine if the correct records were being appended.
I then ran this code:
Code:
Dim fs
Dim fs2
Dim SourceFolder
Dim sSourceDir As String
Dim CurrFile
Rem the Excel Application
Dim objExcel
Rem the path to the excel file
'Dim excelPath
Rem how many worksheets are in the current excel file
Dim worksheetCount
Dim counter
Rem the worksheet we are currently getting data from
Dim currentWorkSheet
Rem the number of columns in the current worksheet that have data in them
Dim usedColumnsCount
Rem the number of rows in the current worksheet that have data in them
Dim usedRowsCount
Dim row
Dim column
Rem the topmost row in the current worksheet that has data in it
Dim top
Rem the leftmost row in the current worksheet that has data in it
Dim leftct
Dim Cells
Rem the current row and column of the current worksheet we are reading
Dim curCol
Dim curRow
Rem the value of the current row and column of the current worksheet we are reading
Dim word
Dim sSQL As String
Dim db As Database
sSourceDir = "c:"
Set fs = CreateObject("scripting.filesystemobject")
Set SourceFolder = fs.getfolder("c:")
Set db = CurrentDb
For Each CurrFile In SourceFolder.files
sFileName = CurrFile.Name
sExcelFile = sSourceDir & "\" & sFileName
If InStr(sFileName, ".xls") Then
Debug.Print "Reading Data from " & sExcelFile
Rem Create an invisible version of Excel
Set objExcel = CreateObject("Excel.Application")
Rem don't display any messages about documents needing to be converted
Rem from old Excel file formats
objExcel.DisplayAlerts = 0
Rem open the excel document as read-only
Rem open (path, confirmconversions, readonly)
objExcel.Workbooks.Open sExcelFile, False, True
Rem How many worksheets are in this Excel documents
worksheetCount = objExcel.worksheets.Count
Debug.Print "We have " & worksheetCount & " worksheets"
Rem Loop through each worksheet
For counter = 1 To worksheetCount
Debug.Print "-----------------------------------------------"
Debug.Print "Reading data from worksheet " & counter & vbCrLf
Set currentWorkSheet = objExcel.ActiveWorkbook.worksheets(counter)
Rem how many columns are used in the current worksheet
usedColumnsCount = currentWorkSheet.UsedRange.Columns.Count
Rem how many rows are used in the current worksheet
usedRowsCount = currentWorkSheet.UsedRange.Rows.Count
Rem What is the topmost row in the spreadsheet that has data in it
top = currentWorkSheet.UsedRange.row
Rem What is the leftmost column in the spreadsheet that has data in it
leftct = currentWorkSheet.UsedRange.column
Set Cells = currentWorkSheet.Cells
Rem Loop through each row in the worksheet
For row = 0 To (usedRowsCount - 1)
Rem Loop through each column in the worksheet
curRow = row + top
curCol = column + leftct
If Cells(curRow, 1) <> "" Then
sSQL = "INSERT INTO Imports (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O) VALUES ("
For column = 0 To usedColumnsCount - 1
Rem only look at rows that are in the "used" range
curRow = row + top
Rem only look at columns that are in the "used" range
curCol = column + leftct
Rem get the value/word that is in the cell
word = Cells(curRow, curCol).Value
Rem display the column on the screen
If curCol = 1 Then
sSQL = sSQL & "#" & word & "#,"
Else
sSQL = sSQL & word & ", "
End If
'Debug.Print "CurRow " & curRow & " CurCol " & curCol & " " & (word)
Next
sSQL = left(sSQL, Len(sSQL) - 2) & ")"
Debug.Print sSQL
db.Execute sSQL
End If
Next
Rem We are done with the current worksheet, release the memory
Set currentWorkSheet = Nothing
Next
objExcel.Workbooks(1).Close
objExcel.Quit
End If
Next
Set currentWorkSheet = Nothing
Rem We are done with the Excel object, release it from memory
Set objExcel = Nothing
db.Close
End Sub
NOTES:
I used the code on this site for cycling through the excel file:
http://www.gregthatcher.com/Papers/V...actScript.aspx
I just modified it to fit your need.
The code assumes you may have data on all worksheets in the excel file
The code assumes that ONLY records with something in column 1 will need to be appended.
The code assumes that the ONLY DATA you need to append are in columns where column 1 is not blank.
If you need to add things like the original filename or any of the data that is in rows that DO NOT have anything in the first column you will have to program for that as well.