Need VBA code help to import excel files

[SKV]

I am working with a cross-functional team and responsible for consolidating information from multiple users.
All the users drop their files in a specific folder with agreed upon files names and tab names. Not all the users provide same information(i.e. is some provide sales related info and some provide production information)

Currently I get around 30 excel files which I have to load into access in different tables based on for file and tab name. I need help to write a code to do the following.

Step1: read file (xlsx) names and their tab names and check each for now of row and columns having data. Store this information in a table (Say: TBL_File_List)
[TABLE="width: 500"]
<tbody>[TR]
[TD]File Name[/TD]
[TD]TabName[/TD]
[TD]Rows[/TD]
[TD]Columns[/TD]
[TD]TimeStamp[/TD]
[/TR]
[TR]
[TD]FileA[/TD]
[TD]Mtl_list[/TD]
[TD]20[/TD]
[TD]12[/TD]
[TD]2012-10-13 1pm[/TD]
[/TR]
[TR]
[TD]FileA[/TD]
[TD]BOM[/TD]
[TD]37[/TD]
[TD]12[/TD]
[TD]2012-10-13 1pm[/TD]
[/TR]
[TR]
[TD]File2[/TD]
[TD]Sales[/TD]
[TD]1000[/TD]
[TD]20[/TD]
[TD]2012-10-13 2pm[/TD]
[/TR]
</tbody>[/TABLE]

Step2: Import each tab from each file per table TBL_File_List and use logic (based on filename and tab name) to import it to specific destination tables and also time stamp each record

Step3: Rename each file, example fileA as fileA_20121013.xlsx.

Step4: Move all the files to Archive folder

Though I able to do this partly by getting some code snippets from internet but it is still not smooth. So I am looking for a clean new approach to do this task especially part 1 which what I am struggling on.

I look forward to help from talented people on this group.

Thanks
SKV

 

[SKV]

Can anyone advice me how to accomplish Step1 in the problem above?

 

[Kreszch68]

Hi, I don't have much time now to explain from a to z, but to get you going take a look at the next code.
The first piece is to create two tables, one to store the excel files, one to store the sheets with their properties.


So first run this code once to create the tables

'Set a reference to
'Microsoft Active-X Data Objects x.xx

Public Sub CreateSomeTables()
Dim cn As ADODB.Connection
Dim sSQL As String
Set cn = CurrentProject.Connection
sSQL = "CREATE TABLE [tExcelFiles] (ExcelFileID Counter CONSTRAINT PK_ExcelFileID PRIMARY KEY, ExcelFileName Text (255), ExcelFilePath Text (225), WorkbookLastModified DateTime, Processed YesNo DEFAULT 0 )"
cn.Execute sSQL
sSQL = "CREATE TABLE tWorkSheets (WorkSheetID Counter CONSTRAINT PK_WorksheetID PRIMARY KEY, ExcelFileID Integer NOT NULL CONSTRAINT FK_ExcelFileID REFERENCES tExcelFiles (ExcelFileID), WorkSheetName Text (255), NRows Integer, NCols Integer,  Processed YesNo DEFAULT 0 )"
cn.Execute sSQL
 
End Sub

Then use this part to read a specific folder and parse the file information to the tables you just created

'Set a reference to
'Microsoft Active-X Data Objects x.xx
'Microsoft Excel xx Object Library
'Microsoft Scripting Runtime

Public Sub ScanFolder()
On Error GoTo err_ScanFolder
Const BASE_FOLDER As String = [COLOR=#ff0000][B]"Set path to folder here"[/B][/COLOR]
Dim vExcelFiles() As Variant
Const iFileName As Integer = 0
Const iFilePath As Integer = 1
Const iFileLastMod As Integer = 2
Dim vExcelSheets() As Variant
Const iExcelID As Integer = 0
Const iWorksheet As Integer = 1
Const iNRows As Integer = 2
Const iNCols As Integer = 3
Dim FSO As New FileSystemObject
Dim oFolder As Folder
Dim oFile As File
Dim i_File As Integer
Dim i_WS As Integer
Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Dim sSQL As String
Dim oXLApp As New Excel.Application
Dim oXlWorkbook As Excel.Workbook
Dim oXlSheet As Excel.Worksheet
Dim sFileName As String
Set dbs = CurrentDb
Set oFolder = FSO.GetFolder(BASE_FOLDER)
If oFolder.Files.Count = 0 Then 'no files
    MsgBox "No Files in folder :" & BASE_FOLDER
    GoTo Exit_ScanFolder
End If
'Read all file info to array
ReDim vExcelFiles(2, oFolder.Files.Count - 1)
    
    For Each oFile In oFolder.Files
        vExcelFiles(iFileName, i_File) = oFile.Name
        vExcelFiles(iFilePath, i_File) = oFile.Path
        vExcelFiles(iFileLastMod, i_File) = oFile.DateLastModified
        i_File = i_File + 1
    Next oFile
    
'write array to tExcelFiles
For i_File = 0 To UBound(vExcelFiles, 2)
sSQL = "Insert Into tExcelFiles (ExcelFileName, ExcelFilePath, WorkbookLastModified ) " _
     & "Values ('" & vExcelFiles(iFileName, i_File) & "', '" & vExcelFiles(iFilePath, i_File) & "', #" & vExcelFiles(iFileLastMod, i_File) & "#)"
     dbs.Execute sSQL
Next i_File
'Read all onprocessed files and fetch worksheets
'then write sheetnames to table tWorksheets
sSQL = "Select ExcelFileID,ExcelFileName, ExcelFilePath " _
     & "From tExcelFiles " _
     & "Where Processed = 0"
Set rs = dbs.OpenRecordset(sSQL)
ReDim vExcelSheets(3, 0)
With rs
    .MoveFirst
    Do Until .EOF
       Set oXlWorkbook = oXLApp.Workbooks.Open(.Fields("ExcelFilePath").Value)
       
        For Each oXlSheet In oXlWorkbook.Worksheets
            ReDim Preserve vExcelSheets(3, i_WS)
            vExcelSheets(iExcelID, i_WS) = .Fields("ExcelFileID").Value
            vExcelSheets(iWorksheet, i_WS) = oXlSheet.Name
            vExcelSheets(iNRows, i_WS) = oXlSheet.UsedRange.Rows(oXlSheet.UsedRange.Rows.Count).Row
            vExcelSheets(iNCols, i_WS) = oXlSheet.UsedRange.Columns(oXlSheet.UsedRange.Columns.Count).Column
            i_WS = i_WS + 1
        Next oXlSheet
        oXlWorkbook.Close
    .MoveNext
    Loop
End With
Set oXLApp = Nothing
'Start writing to table tWorksheets
For i_WS = 0 To UBound(vExcelSheets, 2)
sSQL = "Insert Into tWorkSheets (ExcelFileID, WorkSheetName, NRows, NCols ) " _
     & "Values ('" & vExcelSheets(iExcelID, i_WS) & "', '" & vExcelSheets(iWorksheet, i_WS) & "'," & vExcelSheets(iNRows, i_WS) & "," & vExcelSheets(iNCols, i_WS) & ")"
     dbs.Execute sSQL
Next i_WS

Exit_ScanFolder:
    Exit Sub
err_ScanFolder:
    MsgBox Err.Description & vbNewLine & Err.Number, vbCritical, "Procedure: ScanFolder"
End Sub

 

[Kreszch68]

A suggestion to import the data.<o></o>
Assuming that you know from the tab/sheet name what the destination table in your database will be, you also should know how the data is structured on the sheet to perform an import. If this is the case, and if the data is structured like a table having column headers/names, you can use ADO to import the data. By creating a few SQL functions and assigning these to a tab/sheet name you can easily loop all files without the need of opening them (If not password protected that is) and import the data. <o></o>
Notice that in the example I already gave you, both tables have a field ‘processed’. The purpose of this field is to flag the files and sheets that already have been imported to the database. It’s obvious that you should add an update statement somewhere in your code to set the value of this field to -1. <o></o>
Then regarding your step 3 and 4, this can be done using the file system object also, say after flagging the records as processed so you can select on that field to grab all files you need to rename and move.<o></o>
Here is an example, based on the tables as provided in the previous post.<o></o>

Public Sub RenameMoveFiles()
Const ARCHIVE_FOLDER As String = "N:\AGT\IT\Opdrachten\2012\Schatkistbankieren Aanvraagform\ExcelBestanden\Archive\"
Dim FSO As New FileSystemObject
Dim oFile As File
Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Dim sSQL As String
Dim sAntFix As String
Dim sNewName As String
Dim sFileExt As String
sSQL = "Select ExcelFileID,ExcelFileName, ExcelFilePath, WorkbookLastModified " _
     & "From tExcelFiles " _
     & "Where Processed = -1"
Set dbs = CurrentDb
Set rs = dbs.OpenRecordset(sSQL)
With rs
    If .BOF And .EOF Then 'no files to move
        MsgBox "No files to move", vbExclamation
        .Close
        Exit Sub
    End If
    .MoveFirst
        Do Until .EOF
            sAntFix = "_" & Format(.Fields("WorkbookLastModified").Value, "yyyymmdd")
            Set oFile = FSO.GetFile(.Fields("ExcelFilePath").Value)
            sFileExt = "." & FSO.GetExtensionName(.Fields("ExcelFilePath").Value)
            sNewName = ARCHIVE_FOLDER & Replace(oFile.Name, sFileExt, sAntFix & sFileExt)
            oFile.Move (sNewName)
            .MoveNext
        Loop
        .Close
End With
Set rs = Nothing
Set dbs = Nothing
End Sub

 

[SKV]

Thanks, I will test and come back with questions if any.