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
| Sub MiseAJour ()
Dim Liaison, SQL, TabSQL As String
Dim oRequete As Object
Dim oSheet1 As Object
Dim oSheet2 As Object
Const xlOverwriteCells = 0
Dim i, j As Integer
'Exemple de données
Tableau1(1, 1) = "Index WBS"
Tableau1(1, 2) = "Nom"
Tableau1(1, 3) = "Durée"
Tableau1(1, 4) = "Pourcentage_achevé"
Tableau1(1, 5) = "Début"
Tableau1(1, 6) = "Fin"
Tableau1(2, 1) = "Projet_X"
Tableau1(2, 2) = "Réalisation de la maquette"
Tableau1(2, 3) = "70 jours"
Tableau1(2, 4) = "50"
Tableau1(2, 5) = "01/11/2008"
Tableau1(2, 6) = "06/02/2009"
NEnregistrement = 2
Set xls = CreateObject("Excel.Application") 'Ouvre Excel
'Ligne suivante permet de gèrer les accès simultanés (pas d'accès simultané en fait)
xls.workbooks.Open filename:=CheminFichiers & NomFichierConfig & ".xls", ReadOnly:=False
'Ouvre une feuille de résultat intermédiaire
xls.workbooks.Add
Set oSheet1 = xls.activeworkbook.Worksheets("feuil1")
'Ecrit les données dans la feuille Excel temporaire SaisieTemp
For j = 1 To 6
For i = 1 To 2
oSheet1.Cells(i, j).Value = Tableau1(i, j)
Next
Next
xls.activeworkbook.SaveAs filename:="c:\SaisieTemp.xls"
Set oSheet1 = Nothing
Set oSheet2 = xls.workbooks("SaisieTemp.xls").Worksheets("Feuil2")
'Traitement SQL - requète de mise à jour
'Liaison ODBC plus permormante pour l'écriture (bug avec OLEDB)
Liaison = "ODBC;Dsn=Excel Files;Dbq=" & CheminFichiers & NomFichierImport & ".xls" & ";DefaultDir=" & Left(CheminFichiers, Len(CheminFichiers) - 1) & ";driverid=790;maxbuffersize=2048;pagetimeout=5;"
SQL = ""
Set oRequete = oSheet2.QueryTables.Add(Liaison, oSheet2.Range("A1"), SQL)
'Ma requête fait appel à deux tables Excel l une ouverte ci-dessus, l autre fermé
TabSQL = "UPDATE `c:\SaisieTemp`.`Feuil1$` `Feuil1$` INNER JOIN `" & CheminFichiers & NomFichierImport & "`.`Service$` `Service$` ON `Feuil1$`.[Index WBS] = `Service$`.[Index WBS] SET `Service`.[Pourcentage_achevé] = `Feuil1$`.[Pourcentage_achevé], `Service`.[Début] = `Feuil1$`.[Début], `Service$`.Fin = `Feuil1$`.Fin"
oRequete.CommandText = TabSQL
oRequete.FieldNames = True
oRequete.RefreshStyle = xlOverwriteCells
oRequete.Refresh 'Exécution de la requête j'arrive à fermer tous les processus Excel avant, mais pas après
oRequete.ResultRange.ClearContents
oRequete.Delete
'Libération des fichiers Excel et normalement fermeture des derniers processus en cours
Set oRequete = Nothing
Set oSheet2 = Nothing
xls.workbooks("SaisieTemp.xls").Close SaveChanges:=False
xls.workbooks(NomFichierConfig & ".xls").Close SaveChanges:=False
xls.Quit
Set xls = Nothing
End Sub |
