Discussion :

[Manu3100]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[loufab]

Bonjour,

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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,

[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.

[loufab]

Il suffit d'adapter ta ligne filter

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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,

[Manu3100]

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:





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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[loufab]

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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,