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 88 89 90 91 92 93 94 95 96 97 98 99 100
| Sub ADOTest()
'exports data from the active worksheet to a table in an Access database
Dim cn As Object, RS As Object, r As Long
Dim oRange As Range
Dim JRange As Range
Set JRange = ThisWorkbook.Worksheets("Départements").Range("M1")
Application.ScreenUpdating = False
Application.Calculation = xlManual
Worksheets("Parametres").Select
If Range("C70").Value = "Oui" Or Range("C70").Value = "" Then
Compte = Application.WorksheetFunction.CountA(Range("B2:B50"))
If Compte = 0 Then
Set cn = CreateObject("ADODB.Connection")
cn.Open "provider = microsoft.ace.oledb.12.0;" & _
"Data Source=\\sharepoint.ca\Shared Documents\DataBase51.accdb;"
'open a recordset
Set RS = CreateObject("ADODB.Recordset")
Table = "Table1"
RS.Open "Table1", cn, adOpenKeyset, adLockOptimistic, adCmdTable
'all records in a table
r = 38 'the start row in the worksheet
Sql = "delete * FROM Table1 WHERE NoEmployé='" & UserName & "';"
cn.Execute Sql
ThisWorkbook.Activate
Worksheets("TB OPÉRATIONNEL (global)").Select
Range("E9").Select
Do While ActiveCell.Offset(0, 1).Value <> ""
If ActiveCell.Value <> "" Then
r = ActiveCell.Row
Donnée1 = Range("F" & r).Formula
Donnée2 = Range("G" & r).Formula
Donnée3 = Range("H" & r).Formula
Donnée4 = Range("J" & r).Formula
Donnée5 = Range("L" & r).Formula
Donnée6 = Range("N" & r).Formula
Donnée7 = Range("P" & r).Formula
Donnée8 = Range("R" & r).Formula
Donnée9 = Range("T" & r).Formula
Donnée10 = Range("V" & r).Formula
Donnée11 = Range("X" & r).Formula
Donnée12 = Range("Z" & r).Formula
Donnée13 = Range("AB" & r).Formula
Donnée14 = Range("AD" & r).Formula
Donnée15 = Range("AF" & r).Formula
Donnée16 = Range("AH" & r).Formula
Donnée17 = Range("AJ" & r).Formula
Donnée18 = Range("H" & r).NumberFormat
Donnée19 = Range("AL" & r).Formula
'.Fields("DEPT") = "100000"
Donnée20 = Range("AO" & r).Formula
'Sql2 = "INSERT INTO Table1 (NoEmployé, Quadrant, Indicateur, Cible, RendementPrécédent, AVR, MAI, JUIN, JUIL, AOUT, SEPT, OCT, NOV, DEC, JAN, FÉV, MARS, YTD, Inclure, TypeDonnées, DEPT, Com) VALUES ('Test1', 'Test2', 'Test3', 'Test4', 'Test5', 'Test6', 'Test7', 'Test8', 'Test9', 'Test10', 'Test11', 'Test12', 'Test13', 'Test14', 'Test15', 'Test16', 'Test17', 'Test18', 'Test19', 'Test20', 100000, 'Test22')"
Sql2 = "INSERT INTO [Table1] ([NoEmployé], [Quadrant], [Indicateur], [Cible],"
Sql2 = Sql2 & "[RendementPrécédent], [AVR], [MAI], [JUIN], [JUIL], [AOUT], [SEPT], "
Sql2 = Sql2 & "[OCT], [NOV], [DEC], [JAN], [FÉV], [MARS], [YTD], [TypeDonnées], [Inclure],"
Sql2 = Sql2 & " [DEPT], [Com]) VALUES "
Sql2 = Sql2 & "('" & UserName & "', '" & Donnée1 & "', '" & Donnée2 & "', '" & Donnée3 & "', '" & Donnée4 & "', "
Sql2 = Sql2 & "'" & Donnée5 & "', '" & Donnée6 & "', '" & Donnée7 & "', '" & Donnée8 & "', '" & Donnée9 & "', '" & Donnée10 & "', "
Sql2 = Sql2 & "'" & Donnée11 & "', '" & Donnée12 & "', '" & Donnée13 & "', '" & Donnée14 & "', '" & Donnée15 & "', "
Sql2 = Sql2 & "'" & Donnée16 & "', '" & Donnée17 & "', '" & Donnée18 & "', '" & Donnée19 & "', 100000, '" & Donnée20 & "');"
cn.Execute Sql2
End If
ActiveCell.Offset(1, 0).Select
Loop
ThisWorkbook.Activate
RS.Close
Set RS = Nothing
cn.Close
Set cn = Nothing
End If
End If
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub |