Mise à jour de la base de donnée MS Access via VBA code

Version imprimable

Bonjour tout le monde,

Je suis nouveaux sur MS Access et j'ai bien évidement quelque questions. Tout les mois je dois mettre a jour la base de donnée a partir de plusieurs excel template (qui sont exactement pareil).

Le process que je fais actuellement:
1- Je consolide tout les template dans un seul fichier excel. CE fichier excel a exactement les meme header que dans les tables de ma db Access.
La premiere ligne sont les header et ensuite chaque ligne correspond a un clients.

Heureusement la consolidation se fait par code VBA :)

2- Une fois la consolidation faite, je met a jours la base de donnée via un code VBA. MAIS je dois le faire marcher pour chaque tables car je n'arrive pas a mettre a jour toutes les table correspondante au client. Le code que j'ai a present permets exclusivement de mettre a jour une seule table.

Dans ma base de donnée j'ai 2 tables: "CompanyInformation" et "FY_All" qui sont relié par la "ID"

Ma question est comment faire pour que se code VBA update en une seule fois les 2 tables en VBA?

Voici le code qui est utilisé:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 Public Sub SupplierPort() Dim cn As ADODB.Connection, rs As ADODB.Recordset Dim sDUNS As String, sName As String, cScore 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 "CompanyInformation", cn, adOpenKeyset, adLockOptimistic, adCmdTable Range("A2").Activate ' row 1 contains column headings Do While Not IsEmpty(ActiveCell) sDUNS = ActiveCell.Value sName = ActiveCell.Offset(0, 1).Value cScore = ActiveCell.Offset(0, 2).Value rs.Filter = "DUNS='" & sDUNS & "' AND Name='" & sName & "'" If rs.EOF Then Debug.Print "No existing record - adding new..." rs.Filter = "" rs.AddNew rs("DUNS").Value = sDUNS rs("Name").Value = sName Else Debug.Print "Existing record found..." End If rs("Score").Value = cScore rs.Update Debug.Print "...record update complete." ActiveCell.Offset(1, 0).Activate ' next cell down Loop rs.Close Set rs = Nothing cn.Close Set cn = Nothing End Sub
Si je ne suis pas claire dans mes propos dite le mois je répondrais pour vous donner des precisions.

Merci d'avance

Bonjour,

Tu dois déclare un 2ème rs. Voici le plan d'ensemble.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
dim rs2 as ....
 
...
 
Set rs2 = New ADODB.Recordset
rs2.Open "2ème table", cn, adOpenKeyset, adLockOptimistic, adCmdTable
 
...
    rs.Filter...
    ...
    Endif
 
    rs2.Filter = "DUNS='" & sDUNS & "' AND Name='" & sName & "'"
    If rs2.EOF Then
        Debug.Print "No existing record - adding new..."
        rs2.Filter = ""
        rs2.AddNew
        rs2("DUNS").Value = sDUNS
        rs2("Name").Value = sName
    Else
        Debug.Print "Existing record found in table 2..."
    End If
...

Idéalement tu devrais faire une fonction pour la partie filter/addnew puisque qu'il semble que ce soit le même code. Mais ce n'est pas obligé.

Cordialement,

01/09/2015, 16h54
Manu3100

Merci beaucoup pour ta réponse.

Dans la première table je filtre avec DUNS et SupplierName. Puis les informations se mette a jour correctement.

Mais pour la 2eme table j'aimerais filtrer en fonction du "DUNS" et "SupplierName" et "SupplierID" ( qui est sur les 2 tables) et en fonction de SupplierID filtrer la 2eme table et mettre a jour.

J’espère avoir étais claire...

Merci pour ton aide.
01/09/2015, 21h35
loufab
Il suffit d'adapter ta ligne filter

Code:

rs2.Filter = "DUNS='" & sDUNS & "' AND Name='" & sName & "'"

et si c'est mettre à jour au lieu d'ajouter il faut d'abord non plus ajouter (addnew) mais mettre à jour (edit / update)

Comme ceci :
Code:

1 2 3 4 5 6 7 rs2.Filter = "DUNS='" & sDUNS & "' AND Supplier..... If not rs2.eof then rs2.edit rs2.fields("champ") = aduns ... rs2.update endif
Dans cette partie :
Code:

1 2 3 4 sDUNS = ActiveCell.Value sName = ActiveCell.Offset(0, 1).Value cScore = ActiveCell.Offset(0, 2).Value ...
Rajoute le supplier et tout ce que tu as besoin pour ton rs2.

Cordialement,

1 pièce(s) jointe(s)

Bonjour,

J'ai suivi tes conseils a la lettre mais je n'y arrive toujours pas. Voici un Screenshots de mes tables peut être cela sera plus claire:

Pièce jointe 186951

Et quand je lance le code ci dessous j'ai une erreur "3265" dans ma ligne de filter rs2. Car "SupplierName" n'existe que dans la table "CompanyInformation" et pas dans la table "All_FY".

Les 2 table sont reliées avant "SupplierID".

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Public Sub AccedPortfolio()
 
Dim cn As ADODB.Connection
Dim rs, rs2 As ADODB.Recordset
Dim sDUNS As String, sSupplierName  As String, sRiskScore As Variant
Dim sSupplierID As String, sFY As String, sQuickRatio As Variant
 
' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
    "Data Source=C:\Users\290866\Desktop\vba\MS Access\Database2.accdb;"
' open a recordset
Set rs = New ADODB.Recordset
  Set rs2 = New ADODB.Recordset
rs.Open "CompanyInformation", cn, adOpenKeyset, adLockOptimistic, adCmdTable
rs2.Open "All_FY", cn, adOpenKeyset, adLockOptimistic, adCmdTable
 
Range("A2").Activate  ' row 1 contains column headings
Do While Not IsEmpty(ActiveCell)
    sDUNS = ActiveCell.Value
    sSupplierName = ActiveCell.Offset(0, 1).Value
    sRiskScore = ActiveCell.Offset(0, 2).Value
    sFY = ActiveCell.Offset(0, 48).Value
    sSupplierID = ActiveCell.Offset(0, 49).Value
    sQuickRatio = ActiveCell.Offset(0, 50).Value
 
    rs.Filter = "DUNS='" & sDUNS & "' AND SupplierName='" & sSupplierName & "'"
 
    If rs.EOF Then
        Debug.Print "No existing record - adding new..."
        rs.Filter = ""
        rs.AddNew
        rs("DUNS").Value = sDUNS
        rs("SupplierName").Value = sSupplierName
    Else
        Debug.Print "Existing record found..."
    End If
    rs("RiskScore").Value = sRiskScore
    rs.Update
    Debug.Print "...record update complete."
 
rs2.Filter = "FY='" & sFY & "' AND SupplierName='" & sSupplierName & "'"
 
If rs2.EOF Then
    rs2.AddNew
    rs2.Fields("FY") = sFY
     Else
        Debug.Print "Existing record found..."
    End If
    rs2("QuickRatio").Value = sQuickRatio
    rs2.Update
    Debug.Print "...record update complete."
 
 
    ActiveCell.Offset(1, 0).Activate  ' next cell down
Loop
 
rs.Close
Set rs = Nothing
rs2.Close
Set rs2 = Nothing
cn.Close
Set cn = Nothing
End Sub

Bonjour,
Code:

1 2 3 4 5 6 7 8 If rs2.EOF Then rs2.AddNew rs2.Fields("FY") = sFY Else Debug.Print "Existing record found..." End If rs2("QuickRatio").Value = sQuickRatio rs2.Update
Il te faut indenter ton code c'est la première chose à faire !

Ainsi tu verras une grosse incohérence :
Code:

1 2 3 4 5 6 7 8 9 If rs2.EOF Then rs2.AddNew rs2.Fields("FY") = sFY Else Debug.Print "Existing record found..." End If rs2("QuickRatio").Value = sQuickRatio rs2.Update
Tu fais un addnew sous condition mais un update systématique. Un update ne fonctionne pas sans Addnew ou Edit.

Cordialement,