[AC-2003] Probleme Echange excel access, sql, retour chariot vba

Bonjour, J'aimerais savoir si vous pourriez m'aider car ca fait plusieurs jours que je travaille sur ce code et que soit je n'y arrive pas soit sa fait planter mon PC. Je vous remercie d'avance.

Je suis actuellement en train de développer une base de donnée de site de gestion d'eaux pour mon stage. Celle ci réalise sur un click une importation de fichiers excel présent sur le réseau pour mettre à jour les sites. J 'ai déja eu l'occasion de trouver sur le forum des bouts de programmes me permettant de réaliser les actions que je désire (notament celle de cafeine, que je remercie encore):

-Importer des fichiers depuis le réseaux
-Vérifier l'existence de ces fichiers
-Vérifier si ces fichiers sont déja ouvert ou pas
Récuperer le contenu de certaines colonnes des fichiers et les regrouper dans une seule feuille ( T_importation_Als_Lor).
- Eviter les carrés blanc du au retour chariot et alignement
...

Cependant je me retrouve face à différents problèmes:

- j'arrive à importer les données, cependant dans les adresses les termes ( lieux dit ex : " le toto") me ressortent en probleme. J'ai testé avec les doubles "" mais cela ne marche toujours pas. en effet cela me signale une erreur ou refuse de me l'importer.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Set oApp = CreateObject("excel.application")
Set oWkb = oApp.Workbooks.Open(result) 'mettez ici le chemin vers votre fichier Excel
Set oWSht = oWkb.Worksheets(result2) 'mettez ici le nom de la feuille qui contient les données à importer
 
 While oWSht.Range("C" & i).Value <> "" '(où C représente la colonnede Id national et i la ligne)
    If DCount("*", "[T_Importation_PPV_Alsace_Lorraine]", "[ID national site] LIKE '" & oWSht.Cells(i, 1) & "'") = 0 Then
        'cSQL = " insert into [T_Importation_PPV_Alsace_Lorraine] ( [Délégation], [Centre régional],[ID national site], [Nom du site], [Contractant], [Commune], [code INSEE], [Type de site], [Fililale], [Adresse], [identifiant libre local], [Domaine Fonctionnel], [Champ13] ) values ("" & Chr(34) & oWSht.Cells(i, 1) & Chr(34) & "", "" & Chr(34) & oWSht.Cells(i, 2) & Chr(34) & "", "" & Chr(34) & oWSht.Cells(i, 3) & Chr(34) & "", "" & Chr(34) & oWSht.Cells(i, 4) & Chr(34) & "", "" & Chr(34) & oWSht.Cells(i, 5) & Chr(34) & "", "" & Chr(34) & oWSht.Cells(i, 6) & Chr(34) & "", "" & Chr(34) & oWSht.Cells(i, 7) & Chr(34) & "", "" & Chr(34) & oWSht.Cells(i, 8) & Chr(34) & "", "" & Chr(34) & oWSht.Cells(i, 10) & Chr(34) & "", "" & Chr(34) & oWSht.Cells(i, 11) & Chr(34) & "", "" & Chr(34) & oWSht.Cells(i, 14) & Chr(34) & "", "" & Chr(34) & oWSht.Cells(i, 34) & Chr(34) & "", "" & Chr(34) & oWSht.Cells(i, 35) & Chr(34) & "");"
        cSQL = " insert into [T_Importation_PPV_Alsace_Lorraine] ( [Délégation], [Centre régional],[ID national site], [Nom du site], [Contractant], [Commune], [code INSEE], [Type de site], [Fililale], [Adresse], [identifiant libre local], [Domaine Fonctionnel]) values (" & Chr(34) & oWSht.Cells(i, 1) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 2) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 3) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 4) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 5) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 6) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 7) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 8) & Chr(34) & "," & Chr(34) & oWSht.Cells(i, 10) & Chr(34) & ", "" & oWSht.Cells(i, 11)  &"", " & Chr(34) & oWSht.Cells(i, 14) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 34) & Chr(34) & ");"
        comptagenouveau = comptagenouveau + 1
        DoCmd.RunSQL cSQL
    End If
     If DCount("*", "[T_Importation_PPV_Alsace_Lorraine]", "[ID national site] LIKE '" & oWSht.Cells(i, 1) & "'") = 1 Then
      End If

- Au niveau du retour chariot j'utilise une fonction trouvé sur le site
:http://support.microsoft.com/default...%3Bfr%3B210372

Elle fonctionne dans le mode requête mais impossible de la lancer en VBA SQL Cela me sort erreur 3144J'ai ensuite essayer par la méthode current.db mais la aussi sa me met erreur 3219.

Code:

1
2
3
SQL11 = " UPDATE T_Importation_PPV_Alsace_Lorraine SET T_Importation_PPV_Alsace_Lorraine.Adresse = ChangeStr([Adresse],Chr$(10),Chr$(13) & Chr$(10),0)"
DoCmd.RunSQL SQL11
'CurrentDb.QueryDefs("Requête2").SQL = SQL

-Mon dernier probleme est la mise en place de verification si le fichier est ouvert sur un autre pc et a ce moment annuler l'import .

J 'ai essayé différentes méthodes sans pour autant de succés.

Voici l'ensemble des actions réalisés par mon code lors de l'appui sur le bouton

Code:

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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
 
Private Sub Cmd_Mise_a_jour_Click()
 
Dim SQL10, SQL11, result, result2 As String
Dim SqlStr As String, Db As DAO.Database
Dim daterecuperedelatable, tes As String
Dim oApp As Excel.Application
Dim oWkb As Excel.Workbook
Dim oWSht As Excel.Worksheet
Dim comptagenouveau As Long
Dim testexistenceFichie As String
Dim msgbox_test As String
 
'On Error GoTo Err_Cmd_Mise_a_jour_Click   '#Actuellement coupés afin de pouvoir visualiser les erreurs
 
result = DLookup("[chemins d'acces alsace]", "T_table_date_mise_à_jour")  '# Chemins d'accés au excel
result2 = DLookup("[feuille alsace]", "T_table_date_mise_à_jour")
 
 testexistenceFichie = Dir(result)                                         ' test existence du premier fichier
If testexistenceFichie = "" Then
    msgbox_test = MsgBox("Fichier ALSACE inexistant, Vérifier le chemin d'accés, données non importés", vbCritical)
    Forms!F_frm_option.Show
 
Else
    'On Error Resume Next                                                                     'Essai de code pour vérifier si le fichier est déja ouvert ou pas
    'Windows(result).Activate
       ' If Err = 0 Then
 
 
           ' msgbox_test = MsgBox("Fichier Alsace utilisé par un autre utilisateur ou déjà ouvert")
           ' GoTo Err_Cmd_Mise_a_jour_Click
 
 
       ' Else
 
            Set oApp = CreateObject("excel.application")
            Set oWkb = oApp.Workbooks.Open(result) 'mettez ici le chemin vers votre fichier Excel
            Set oWSht = oWkb.Worksheets(result2) 'mettez ici le nom de la feuille qui contient les données à importer
            comptagenouveau = 0
            i = 1 'première ligne ou commence l'import pour eviter d'importer les entêtes du fichier excel
 
           DoCmd.SetWarnings False 'pour éviter les messages lors de l'ajout des enregistrements
 
            While oWSht.Range("C" & i).Value <> "" '(où C représente la colonnede Id national et i la ligne)'condition de remplissage de la table => eviter les doublons si l'enregistrement existe déjà dans la table destination, on passe à la ligne suivante sans l'importer
 
                If DCount("*", "[T_Importation_PPV_Alsace_Lorraine]", "[ID national site] LIKE '" & oWSht.Cells(i, 1) & "'") = 0 Then
                    cSQL = " insert into [T_Importation_PPV_Alsace_Lorraine] ( [Délégation], [Centre régional],[ID national site], [Nom du site], [Contractant], [Commune], [code INSEE], [Type de site], [Fililale], [Adresse], [identifiant libre local], [Domaine Fonctionnel]) values (" & Chr(34) & oWSht.Cells(i, 1) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 2) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 3) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 4) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 5) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 6) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 7) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 8) & Chr(34) & "," & Chr(34) & oWSht.Cells(i, 10) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 11) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 14) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 34) & Chr(34) & ");"
                    comptagenouveau = comptagenouveau + 1
                    DoCmd.RunSQL cSQL
                End If
                If DCount("*", "[T_Importation_PPV_Alsace_Lorraine]", "[ID national site] LIKE '" & oWSht.Cells(i, 1) & "'") = 1 Then
                 End If
 
                   i = i + 1 'on incrémente la variable i pour passer à la ligne suivante
            Wend
 
            oWkb.Save
            oApp.Quit
            Set oWSht = Nothing
            Set oWbk = Nothing
            Set oApp = Nothing
            Set Db = Nothing
    'End If
End If                                      ' J'ai procéder exactement de la même maniere pour vérifier et importer l'autre fichier
 
 
result = DLookup("[chemins d'acces lorraine]", "T_table_date_mise_à_jour")
reult2 = DLookup("[feuille lorraine]", "T_table_date_mise_à_jour")
 
testexistenceFichie = Dir(result)
If testexistenceFichie = "" Then
  msgbox_test = MsgBox("Fichier LORRAINE inexistant, Vérifier le chemin d'accés, données non importés", vbCritical)
    Forms!F_frm_option.Show
Else
        'Workbooks(result).Activate
   ' If Err = 1004 Then
      ' ' msgbox_test = MsgBox("Fichier lorraine utilisé par un autre utilisateur ou déjà ouvert")
       ' oWkb.Save
       ' oApp.Quit
       ' Set oWSht = Nothing
       ' Set oWbk = Nothing
        'Set oApp = Nothing
       'Set Db = Nothing
Set oApp = CreateObject("excel.application")
Set oWkb = oApp.Workbooks.Open(result) 'mettez ici le chemin vers votre fichier Excel
Set oWSht = oWkb.Worksheets(result2) 'mettez ici le nom de la feuille qui contient les données à importer
 
 While oWSht.Range("C" & i).Value <> "" '(où C représente la colonnede Id national et i la ligne)
    If DCount("*", "[T_Importation_PPV_Alsace_Lorraine]", "[ID national site] LIKE '" & oWSht.Cells(i, 1) & "'") = 0 Then
        'cSQL = " insert into [T_Importation_PPV_Alsace_Lorraine] ( [Délégation], [Centre régional],[ID national site], [Nom du site], [Contractant], [Commune], [code INSEE], [Type de site], [Fililale], [Adresse], [identifiant libre local], [Domaine Fonctionnel], [Champ13] ) values ("" & Chr(34) & oWSht.Cells(i, 1) & Chr(34) & "", "" & Chr(34) & oWSht.Cells(i, 2) & Chr(34) & "", "" & Chr(34) & oWSht.Cells(i, 3) & Chr(34) & "", "" & Chr(34) & oWSht.Cells(i, 4) & Chr(34) & "", "" & Chr(34) & oWSht.Cells(i, 5) & Chr(34) & "", "" & Chr(34) & oWSht.Cells(i, 6) & Chr(34) & "", "" & Chr(34) & oWSht.Cells(i, 7) & Chr(34) & "", "" & Chr(34) & oWSht.Cells(i, 8) & Chr(34) & "", "" & Chr(34) & oWSht.Cells(i, 10) & Chr(34) & "", "" & Chr(34) & oWSht.Cells(i, 11) & Chr(34) & "", "" & Chr(34) & oWSht.Cells(i, 14) & Chr(34) & "", "" & Chr(34) & oWSht.Cells(i, 34) & Chr(34) & "", "" & Chr(34) & oWSht.Cells(i, 35) & Chr(34) & "");"
        cSQL = " insert into [T_Importation_PPV_Alsace_Lorraine] ( [Délégation], [Centre régional],[ID national site], [Nom du site], [Contractant], [Commune], [code INSEE], [Type de site], [Fililale], [Adresse], [identifiant libre local], [Domaine Fonctionnel]) values (" & Chr(34) & oWSht.Cells(i, 1) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 2) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 3) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 4) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 5) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 6) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 7) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 8) & Chr(34) & "," & Chr(34) & oWSht.Cells(i, 10) & Chr(34) & ", "" & oWSht.Cells(i, 11)  &"", " & Chr(34) & oWSht.Cells(i, 14) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 34) & Chr(34) & ");"
        comptagenouveau = comptagenouveau + 1
        DoCmd.RunSQL cSQL
    End If
     If DCount("*", "[T_Importation_PPV_Alsace_Lorraine]", "[ID national site] LIKE '" & oWSht.Cells(i, 1) & "'") = 1 Then
      End If
 
i = i + 1 'on incrémente la variable i pour passer à la ligne suivante
 
Wend
 
    oWkb.Save
    oApp.Quit
Set oWSht = Nothing
Set oWbk = Nothing
Set oApp = Nothing
Set Db = Nothing
End If
 
'Mise à jour de l'historique
 SQL10 = " Insert into [T_tableau_historique]([Date],[description]) values (now(), " & Chr(34) & comptagenouveau & " nouveau(x) site(s) ont été ajoutés " & Chr(34) & ")"
DoCmd.RunSQL SQL10
 
 
' requête modif-retour chariot
 
'SQL11 = " UPDATE T_Importation_PPV_Alsace_Lorraine SET T_Importation_PPV_Alsace_Lorraine.Adresse = ChangeStr([Adresse],Chr$(10),Chr$(13) & Chr$(10),0)"
'DoCmd.RunSQL SQL11
CurrentDb.QueryDefs("Requête2").SQL = SQL
 
DoCmd.SetWarnings True 'on réactive les messages d'erreurs
 
 
 
MsgBox "Import des fichier Excel réussi.", vbInformation + vbOKOnly, "Opération terminée..."
Set Db = CurrentDb
If DCount("*", "T_table_date_mise_à_jour") = 0 Then
SqlStr = "INSERT INTO T_table_date_mise_à_jour(Mise_a_jour) VALUES (now())"
Else
SqlStr = "UPDATE T_table_date_mise_à_jour SET T_table_date_mise_à_jour.Mise_a_jour = date();"
End If
Db.Execute (SqlStr)
Me.txt_datenn.Requery
Me.txt_datenn.ForeColor = QBColor(0)  '(Pour le rouge)
Me.lbl_derniere_maj.ForeColor = QBColor(0)
Forms!F_MENU_PRINCIPAL.Refresh
 
 
 
Exit_Cmd_Mise_a_jour_Click:
    Exit Sub
 
Err_Cmd_Mise_a_jour_Click:
    MsgBox Err.description
        oWkb.Save
    oApp.Quit
Set oWSht = Nothing
Set oWbk = Nothing
Set oApp = Nothing
Set Db = Nothing
    Resume Exit_Cmd_Mise_a_jour_Click
 
End Sub