Update multiple tables using linked table from Excel

[jaryszek]

Hi,



i have one big table (bad architecture and now i have to do workarounds) in Access which contains multiple small users' tables (union all query).
Small Tables are updating from Excel. Administrator uses the union all query tables via connection in Excel.

Now administrator can update one record from Excel (using ADODB connection) and it is ok:

Lokalizacja_Pliku = "C:\Users\ljar01\Desktop\Makro\Pełnomocnictwa\Baza_Pełnomocnictwa.mdb"Lokalizacja_Folderu = "C:\Users\ljar01\Desktop\Makro\Pełnomocnictwa\"


For Each uForm In UserForms


If uForm.Name = "SkanForm" Then
    Wiersz = SkanForm.TextBox_Wiersz_S.Value
ElseIf uForm.Name = "Generacja" Then
    Wiersz = Generacja.TextBox_Wiersz_P.Value
End If


Next uForm


Login = A_Wniosek.Cells(Wiersz, 17)


    Dim cnn As Object
    Dim rst As Object
    Dim fld As Object
    Dim MyConn As String
    Dim lngID As String
    Dim sSQL As String


    Set cnn = CreateObject("ADODB.Connection")
    Set rst = CreateObject("ADODB.Recordset")
    
    lngID = Trim(A_Wniosek.Cells(Wiersz, 1))
    
    sSQL = "SELECT * FROM [tb_" & Login & "] WHERE [Numer zgłoszenia] ='" & lngID & "';"
    
    MyConn = Lokalizacja_Pliku
    
On Error GoTo Koniec


    With cnn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .Open MyConn
    End With


    rst.CursorLocation = adUseServer
    rst.Open Source:=sSQL, ActiveConnection:=cnn, _
             CursorType:=adOpenKeyset, LockType:=adLockOptimistic
             
              rst.Fields(10).Value = A_Wniosek.Cells(Wiersz, 11)
              rst.Fields(11).Value = A_Wniosek.Cells(Wiersz, 12)
              rst.Fields(15).Value = A_Wniosek.Cells(Wiersz, 16)
              rst.Update
    
    ' Close the connection
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing

But problem is when administrator want to update few rows from Excel.
What is the best way to do it?
Loop through all rows in Excel and update Access tables one by one ?
Or maybe different method ?

Best Wishes
and thanks for help,
Jacek Antek

[orange]

Update access tables 1 by 1
AND get your database designed and structured to relational database principles OR continue
and have multiple work arounds that only you understand.
Good luck.

[jaryszek]

thank you orange,

Update access tables 1 by 1

could you please explain how to do it via excel?

AND get your database designed and structured to relational database principles OR continue
and have multiple work arounds that only you understand.

I wish it would be possible ;-) But we had already discussion about this... not in my company

Best Wishes,
Jacek

[jaryszek]

Anyone?

Jacek

[aytee111]

What exactly is your question? Remember, we can't answer Excel questions, only Access.

[jaryszek]

Hi aytee111,

It is Access and Excel question combined - it can not be done separately.

In Excel forums (Mr excel and excelforum) there is no problem with joining Excel and Access topics.

Nevermind,
I did this via macro :

Sub SQL_Baza_Aktualizacja()

Dim Connectstr As String
Dim HurtowniaADO As New ADODB.Connection
Dim ZdanieSQL As String
Dim Login As String
Dim FileName As String
Dim Moja As New MyForm
Dim Lokalizacja_Pliku As String
Dim Lokalizacja_Folderu As String
Dim TimeEntry As String
Dim TicketNumber As String
Dim Wiersz As Long
Dim rs As ADODB.Recordset
Dim NumerSpółki, User, CzasWpisu As String
Dim rsQuery As ADODB.Recordset
Dim NumerZgłoszenia As String
Dim AccessApp As Object
Dim objAccess As Object
Dim uForm As Object
Dim Array_range As Variant
Dim Slownik_table As Object
Dim Slownik_key As Object
Dim i As Long
Dim key As Variant
Dim keyLogin As String
Dim Itemnumber As String
Dim myAddress As String
Dim cnn As Object
Dim rst As Object
Dim fld As Object
Dim MyConn As String
Dim lngID As String
Dim sSQL As String
Dim txt_Variable As String


Set cnn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")


Set Slownik_table = CreateObject("Scripting.dictionary")
Set Slownik_key = CreateObject("Scripting.dictionary")


A_Wniosek.Range("Tabela_Wnioski").ListObject.ListColumns(15).DataBodyRange.Hyperlinks.Delete


'''Set AccessApp = CreateObject("Access.Application")
'''
Lokalizacja_Pliku = "C:\Users\ljar01\Desktop\Makro\Pełnomocnictwa\Baza_Pełnomocnictwa.mdb"
Lokalizacja_Folderu = "C:\Users\ljar01\Desktop\Makro\Pełnomocnictwa\"
'''
FileName = "'" & ThisWorkbook.FullName & "'[Excel 8.0;]"
'''
Array_range = A_Wniosek.Range("Tabela_Wnioski").ListObject.DataBodyRange.Columns("A:Q")


For i = 1 To UBound(Array_range)
    If Not Slownik_table.exists(Array_range(i, 1) & "-" & Array_range(i, 5)) Then
        txt_Variable = Join(Array(Array_range(i, 1), Array_range(i, 11), Array_range(i, 16)), Chr(2))
        Slownik_table.add Array_range(i, 1) & "-" & Array_range(i, 5), txt_Variable
    Else
        MsgBox "Zgłoszenie nr: " & Array_range(i, 1) & " jest zduplikowane, dane się na nim nie zaktualizują"
    End If
Next i


For i = 1 To UBound(Array_range)
    If Not Slownik_key.exists(Array_range(i, 17)) And Len(Array_range(i, 17)) > 1 Then
        Slownik_key.add Array_range(i, 17), i
    Else
        'do nothing
    End If
Next i


''Dim vitems, vkeys As Variant
''vitems = Slownik_key.items
''vkeys = Slownik_key.keys
    
    MyConn = Lokalizacja_Pliku
    
On Error GoTo Koniec


    With cnn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .Open MyConn
    End With
    
    rst.CursorLocation = adUseServer


    For Each key In Slownik_key
        
        keyLogin = key
        
        sSQL = "SELECT * FROM [tb_" & keyLogin & "];"


        rst.Open Source:=sSQL, ActiveConnection:=cnn, _
        CursorType:=adOpenKeyset, LockType:=adLockOptimistic
        
            Do While Not rst.EOF
                'For i = 0 To rst.Fields.Count - 1
                    If Slownik_table.exists(rst.Fields(0).Value & "-" & rst.Fields(4).Value) Then
                           txt_Variable = Slownik_table.Item(rst.Fields(0).Value & "-" & rst.Fields(4).Value)
                           rst.Fields(0).Value = Split(txt_Variable, Chr(2), , vbTextCompare)(0)
                           rst.Fields(10).Value = Split(txt_Variable, Chr(2), , vbTextCompare)(1)
                           rst.Fields(15).Value = Split(txt_Variable, Chr(2), , vbTextCompare)(2)
                    End If
                    'rst.Fields(1).Value = Array_range(i, 1)
                'Next i
            rst.MoveNext
            Loop
    
    rst.Close


    Next key


    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing


Exit Sub
Koniec:
Set rst = Nothing
Set cnn = Nothing


MsgBox "Błąd" & Err.Description & vbCrLf & vbCrLf & "Nr błędu" & Err.Number, vbCritical, "Procedura ADO"


End Sub

So first of all i am using dictionary vba object to have lists of all users' tables.
And i am looping within each table, within each record of current table and i am changing statuses.

And this is all.
Thank you for your help and support,
Best wishes,
Jacek Antek