A challenge (Excel And Access)

[amal1973]

I would like to Access a folder that has 400 excel workbooks. Loop through the folder and accessing a specific sheet. After that I want to Copy selected Cells based on some criteria and then send all theses rows to MS Access.. (All 400 Workbooks are identical in the design, and the sheets name are the same in all workbooks) could this be done?? And if so. Could anyone please tell me where to start?
I have already wrote the excel VBA code for selecting the cells.
Thanks
This is the start of my code
Sub Copy2()
Dim RngDestination As Range
Dim i As Integer
Set RngDestination = Worksheets("Sheet2&quot.Range("A1&quot
For i = Cells(Rows.Count, "M&quot.End(xlUp).Row To 1 Step -1
If Cells(i, "M&quot.Interior.ColorIndex = -4142 Then
Cells((i, "B&quot,(i,"C&quotCells(i,"M&quot).Copy Destination:=RngDestination
Set RngDestination = RngDestination.Offset(RngDestination.Rows.Count)
End If
Next I

But the Rngdestination should not be sheet2,, it should be the access table
Thanks for the tip

 

[monsjic]

This is definitely possible, although I have not attempted to do this myself. Try looking at the Excel Reference Library in Access.

 

[B827]

This code will find files in a folder and store the result in an array.


With Application.FileSearch
.LookIn = FileLoc
.SearchSubFolders = False
.FileName = "*.xls"
If .Execute() > 0 Then
J = .FoundFiles.Count
For I = 1 To J
ReDim Preserve Fnames(I)
Fnames(I) = .FoundFiles(I)
Next I
Else
MsgBox "There were no files found."
End If
End With

 

[ermartinez]

Here's my code for solving this problem. It edits out spreadsheet files that are not part of the group I'm looking for based on the name format. Make sure that the Excel 9.0 Library is in the list of references.

Function GetData(intMonth As Integer) As Boolean
    Dim XLFile As Excel.Workbook
    Dim f, fs, fc, fl
    Dim strPath As String
    Dim strFile As String
    Dim strMessage As String
    Dim indx As Integer
    Dim intCol As Integer
    Dim db As Database
    Dim inRC As Recordset
    
    On Error GoTo Error_Section
    GetData = True
    intCol = intMonth + 1
    Set db = CurrentDb
    Set inRC = db.OpenRecordset("DataTable")
    If inRC.RecordCount > 0 Then
        inRC.Close
        db.Execute "DELETE * FROM [DataTable]"
    End If
    Set fs = CreateObject("Scripting.FileSystemObject")
    strPath = "\\servername\foldername\"
    Set f = fs.GetFolder(strPath)
    Set fc = f.Files
    For Each fl In fc
        If Left(fl.Name, 1) = "P" Then
            If IsNumeric(Mid(fl.Name, 2, 4)) Then
                ' Valid spreadsheet name
                strFileName = strPath & "\" & fl.Name
                Set XLFile = GetObject(strFileName)
                For indx = 2 To XLFile.Worksheets.Count
                    XLFile.Sheets(indx).Activate
                    inRC.AddNew
                    inRC![F1] = XLFile.ActiveSheet.Name
                    inRC![F2] = Nz(XLFile.ActiveSheet.Cells(6, intCol).Value, "$0.00")
                    inRC![F3] = Nz(XLFile.ActiveSheet.Cells(11, intCol).Value, "$0.00")
                    inRC![F4] = Nz(XLFile.ActiveSheet.Cells(28, intCol).Value, "0")
                    inRC.Update
                Next indx
                XLFile.Close False
                Set XLFile = Nothing
            End If
        End If
    Next fl
    inRC.Close
    Set inRC = Nothing
    Set XLFile = Nothing
    Set db = Nothing

    DoCmd.OpenForm "DataTable List"

Error_Section:
    GetData = False
    strMessage = "Error number: " & Err.Number & Chr(13) & Err.Description
    MsgBox strMessage, vbOKOnly
EndFunc:
End Function

My problem is that my spreadsheet files open with the enable/disable macros alert and that makes this process very slow and tedious. Another problem I have is that the Nz function is not really eliminating nulls where the cells are empty. Any suggestions to help with this?

 

[riny]

I had a similar objective.
See "Append data to a table from VBA" in this forum, it may guide you.