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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
| Public Sub MAJRFT()
Dim accObj As Access.application, Msg As String
Dim application As String, dbs As String, workgroup As String
Dim user As String, password As String, cTries As Integer
Dim x
Dim SQL4 As String, SQLrs As String
Dim db As Database
Dim rs As Recordset
SQLrs = "SELECT tbl_A.fld_A, tbl_A.fld_B " & _
"FROM tbl_A;"
Set db = CurrentDb
Set rs = db.OpenRecordset(SQLrs)
' This is the default location of Access
application = "C:\Program Files\Microsoft Office\OFFICE11\MSACCESS.EXE"
' Use the path and name of a secured MDB on your system
dbs = "C:\...\mabase.mdb"
' This is the default workgroup
workgroup = "C:\...\monmdw.mdw"
user = "admin" ' Use a valid username
password = "pass" ' and correct password
x = Shell(application & " " & Chr(34) & dbs & Chr(34) & " /nostartup /user " & user & _
" /pwd " & password & " /wrkgrp " & Chr(34) & workgroup & Chr(34), vbMinimizedFocus)
On Error GoTo WAITFORACCESS
Set accObj = GetObject(, "Access.Application")
' Turn off error handling
On Error GoTo 0
' You can now use the accObj reference to automate Access
Msg = "Access is now open. You can click on Microsoft Access "
Msg = Msg & "in the Taskbar to see that your database is open."
Msg = Msg & vbCrLf & vbCrLf & "When ready, click OK to close."
MsgBox Msg, , "Success!"
''''''''''''''''CODE RS (interaction entre mes 2 bases...
If intLastUpdated > 0 Then
rs.MoveLast
rs.Move -(intLastUpdated - 1)
Do Until rs.EOF
SQL4 = "Delete tbl_B.fld_B " & _
"FROM tbl_B " & _
"WHERE (((tbl_B.fld_B)=" & rs.Fields(1) & "));"
accObj.DoCmd.OpenForm "monform",,,"ID = " & mavariable
accObj.DoCmd.RunSQL SQL4
rs.MoveNext
Loop
Else
MsgBox "pas d'enregistrements importés, pas de mise à jour"
End If
'''''''''''''''''''''''''''''''''''''''''''''''''
accObj.CloseCurrentDatabase
accObj.Quit
Set accObj = Nothing
MsgBox "All Done!", vbMsgBoxSetForeground
Exit Sub
WAITFORACCESS: ' <--- This line must be left-aligned.
' Access isn't registered in the Running Object Table yet, so call
' SetFocus to take focus from Access, wait half a second, and try
' again. If you try five times and fail, then something has probably
' gone wrong, so warn the user and exit.
''SetFocus
If cTries < 5 Then
cTries = cTries + 1
Sleep 500 ' wait 1/2 seconds
Resume
Else
MsgBox "Access is taking too long. Process ended.", _
vbMsgBoxSetForeground
End If
End Sub |
[A-03] exécuter une fonction dans une autre BDD
Répondre avec citation
Envoyé par ibill
Et puis, peut être pourrais-tu faire une seule procédure dans ta BD externe qui recevrait en paramètre le Recordset et se chargerait du reste ?
Partager