Click here for important information about

How to update tables in MS Access from multiple excel scheet

August 26, 2015 at 13:02:38
Specs: mac
Every month I have to UPDATE my MS Access db from approximately 30 excel files. They have all the same structure and format. I try to modify the code below several times to update each tables in my db in once but i didn't succeed.

For the code below I have first to consolidate first all the data from all excel sheet in one. Then I run the code to update my db. However i run he code for every tables because i don't know how to improved the code in order to update using the primary key.

So have 3 questions:

How is it possible to say to the vba code to look at specific range in the excel template which correspond to a specific column in the MS Access db? In order to avoir to consolidate all the excel sheets before updating the db.

The most important for me is : How can i make this vba code update all the tables in once based on the Primary Key?

Top if both question below can be solved: Is it possible to select the Folder where all these excel files are and the code will loop through all files?

Public Sub UpdatePriceList()
Dim cn As ADODB.Connection, rs As ADODB.Recordset
Dim sProduct As String, sVariety As String, cPrice As Variant
' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
    "Data Source=C:\Users\Gord\Desktop\Database1.accdb;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "PriceList", cn, adOpenKeyset, adLockOptimistic, adCmdTable

Range("A2").Activate  ' row 1 contains column headings
Do While Not IsEmpty(ActiveCell)
    sProduct = ActiveCell.Value
    sVariety = ActiveCell.Offset(0, 1).Value
    cPrice = ActiveCell.Offset(0, 2).Value

    rs.Filter = "product='" & sProduct & "' AND variety='" & sVariety & "'"
    If rs.EOF Then
        Debug.Print "No existing record - adding new..."
        rs.Filter = ""
        rs("product").Value = sProduct
        rs("variety").Value = sVariety
        Debug.Print "Existing record found..."
    End If
    rs("price").Value = cPrice
    Debug.Print "...record update complete."

    ActiveCell.Offset(1, 0).Activate  ' next cell down
Set rs = Nothing
Set cn = Nothing
End Sub

thank you in advance!

See More: How to update tables in MS Access from multiple excel scheet

September 17, 2015 at 05:17:16
You will need to produce a function that 1) allows you to select a root folder, or you can specify this in your code, then 2) loops through all the files in that folder and then do something with them. The code below is just an example of how to browse to a folder, it will then print each of the filenames in the debug window.

This can easily be modified to only select Excel files, by checking the extension of each filename, for example

if right(file,4) = ".xls"


if right(file,5) = ".xlsx"
for the later versions of Excel

So this code will need to be modified to do what you want it to, you will need to open each file then, well do what you want with it.

The code

Private Sub Command0_Click()
    Dim RootFolder
    RootFolder = BrowseForFolder
    Dim MyObj As Object, MySource As Object, file As Variant
    file = Dir(RootFolder & "\")
    While (file <> "")
        Debug.Print Right(file, 4)
        file = Dir()
End Sub

Function BrowseForFolder(Optional OpenAt As Variant) As Variant
     'Function purpose:  To Browser for a user selected folder.
     'If the "OpenAt" path is provided, open the browser at that directory
     'NOTE:  If invalid, it will open at the Desktop level

    Dim ShellApp As Object

     'Create a file browser window at the default folder
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

     'Set the folder to that selected.  (On error in case cancelled)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0

     'Destroy the Shell Application
    Set ShellApp = Nothing

     'Check for invalid or non-entries and send to the Invalid error
     'handler if found
     'Valid selections can begin L: (where L is a letter) or
     '\\ (as in \\servername\sharename.  All others are invalid
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
        If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
        GoTo Invalid
    End Select

    Exit Function

     'If it was determined that the selection was invalid, set to False
    BrowseForFolder = False
End Function

message edited by AlwaysWillingToLearn

Report •
Related Solutions

Ask Question