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
| Sub Paramètres()
Dim cn As New ADODB.Connection
Dim rs As ADODB.Recordset
Dim r As Long
Chemin = ActiveWorkbook.Path
Application.CutCopyMode = True
Dim tak As String
tak = "Data Source= D:\Partage_Tak\BDS_Access_finale\bd_sondages_tests.mdb;" & _
"Jet OLEDB:Database Password=MyPwd"
cn.Provider = "Microsoft.Jet.OLEDB.4.0"
cn.Open tak
Set rs = New ADODB.Recordset
rs.Open "[Paramètres]", cn, adOpenKeyset, adLockOptimistic, adCmdTable
r = 2
Do While Len(Range("A" & r).Formula) > 0
With rs
.AddNew
.Fields("N_Sondage") = Range("A" & r).Value
.Fields("Profondeur") = Range("B" & r).Value
.Fields("VIA") = Range("C" & r).Value
.Fields("PO") = Range("D" & r).Value
.Fields("PI") = Range("E" & r).Value
.Fields("PR") = Range("F" & r).Value
.Update
End With
r = r + 1
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End sub |
Partager