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
|
Sub MaJBase()
Dim Cn As ADODB.Connection
Dim Fichier As String
Dim NomFeuille As String, texte_SQL As String
Dim Rst As ADODB.Recordset
'Définit le classeur fermé servant de base de données
Fichier = "\\Serveur\Fichiers Individuels\" & Textbox1.Value & ".xls"
MsgBox Fichier
'Nom de la feuille dans le classeur fermé
NomFeuille = "saisie"
Set Cn = New ADODB.Connection
'--- Connection ---
With Cn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & Fichier & _
";Extended Properties=Excel 8.0;"
.Open
End With
'-----------------
'Définit la requête.
'/!\ Attention à ne pas oublier le symbole $ après le nom de la feuille.
texte_SQL = "SELECT * FROM [" & NomFeuille & "$]"
Set Rst = New ADODB.Recordset
Set Rst = Cn.Execute(texte_SQL)
'Ecrit le résultat de la requête dans la cellule A2
Sheets("" & Textbox1.Value & "").Select
ActiveSheet.Range("A2").CopyFromRecordset Rst
Sheets("MaJ").Select
'--- Fermeture connexion ---
Cn.Close
Set Cn = Nothing
xlInsertData
End Sub
Function esc(txt As String) ' fonction pour remplacer les simples quotes par \'
esc = Trim(Replace(txt, "'", "\'"))
End Function
Sub xlInsertData()
Dim Rs As ADODB.Recordset
Set Rs = New ADODB.Recordset
Dim oconn2 As ADODB.Connection
Set oconn2 = New ADODB.Connection
On Error Resume Next
oconn2.Open "DRIVER={MySQL ODBC 5.1 Driver};" & _
"SERVER=localhost;" & _
"DATABASE=test;" & _
"USER=test;" & _
"PASSWORD=test;" & _
"Option=3"
Set NomColl3 = blop
MsgBox NomColl3
Dim wsCtcts As Worksheet
Set wsCtcts = Worksheets("" & Textbox1.Value & "")
With " & Textbox1.Value & " '<- c'est souvent là que ça bloque
Dim rowctr As Integer
Dim strSQL As String
rowctr = 4 ' commencer depuis la ligne 4
While Trim(.Cells(rowctr, 1)) <> ""
strSQL = "INSERT INTO saisie (Journee, Imputation, Tache, Lieu, Notes, Collaborateur) " & _
"VALUES ('" & esc(Trim(Format(.Cells(rowctr, 1).Value, "YYYY/MM/DD"))) & "', '" & _
esc(Trim(.Cells(rowctr, 2).Value)) & "', '" & _
esc(Trim(.Cells(rowctr, 3).Value)) & "', '" & _
esc(Trim(.Cells(rowctr, 4).Value)) & "', '" & _
esc(Trim(.Cells(rowctr, 5).Value)) & "', '" & _
esc(Trim(.Cells(rowctr, 7).Value)) & "')" & _
"ON DUPLICATE KEY UPDATE Journee = '" & _
esc(Trim(Format(.Cells(rowctr, 1).Value, "YYYY/MM/DD"))) & "', Imputation = '" & _
esc(Trim(.Cells(rowctr, 2).Value)) & "', Tache = '" & _
esc(Trim(.Cells(rowctr, 3).Value)) & "', Lieu = '" & _
esc(Trim(.Cells(rowctr, 4).Value)) & "', Notes = '" & _
esc(Trim(.Cells(rowctr, 5).Value)) & "', Collaborateur = '" & _
esc(Trim(.Cells(rowctr, 7).Value)) & "'"
Rs.Open strSQL, oconn2, adOpenDynamic, adLockOptimistic
rowctr = rowctr + 1
Wend
' Strsql2 = "Delete from saisie where Imputation = ''"
' Rs.Open Strsql2
End With
oconn2.Close
Set oconn2 = Nothing
Rs.Close
Set Rs = Nothing
End Sub |
