@ssanfu
I made the updates you suggested, but got stuck on the date/text part you said.
Do I need to populate the field headings in the Imports Table before I run the macro? All of the files I am looking for have the same headings and format.
Thanks so much for your help. This will help me exponentially when it is all done.
Here is the updated code:
HTML Code:
Option Compare Database
Option Explicit
Sub Import()
Dim sExcelFile As String
Dim sFileName As String
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:\Documents and Settings\R356112\Desktop\Housekeeping\2009"
Set fs = CreateObject("scripting.filesystemobject")
Set SourceFolder = fs.getfolder("C:\Documents and Settings\R356112\Desktop\Housekeeping\2009")
Set db = CurrentDb
For Each CurrFile In SourceFolder.files
sFileName = CurrFile.Name
sExcelFile = sSourceDir & "\" & sFileName
If InStr(sFileName, ".xlsx") 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 (Cost Center,Cost Eleme,Posting,CO Doc #,Amount,User Name,FI Doc,Vendor #,Name,Info Field,Doc Header Text,Line item Text,Invoice #,Entry dt,Inv date,Invoice Month) 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, dbFailOnError
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
Here is the SQL:
HTML Code:
sSQL = "INSERT INTO Imports (Cost Center,Cost Eleme,Posting,CO Doc #,Amount,User Name,FI Doc,Vendor #,Name,Info Field,Doc Header Text,Line item Text,Invoice #,Entry dt,Inv date,Invoice Month) 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, dbFailOnError
Windows XP 
Access 2007
Reply With Quote
