Discussion :

[sharpeye]

Bonjour,

j ' ai fait une macro sous access qui appelle un fichier excel dans lequel s'execute une macro a l ouverture, qui termine par la creation d'un fichier temporaire : tempfile.xls qui est la source pour l importation des donnees et ensuite effacer.

Voila mon pb : la macro access continu des que le fichier excel est ouvert et creer donc une erreur parce que le ficheir temporaire est inexistant. est ce que je peut synchroniser ca ?

PS : j ai essayer de faire la macro excel sous access, mais j obtient une erreur parce que certaine donnees sont trop longues alors que pour une importation, access met directement ces champs en memo.

ci dessous le code access avec appel a excel

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
'open the XMLimpor.xls to create a new table
DoCmd.RunMacro ("openExcel")
'import the table
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "New Reference", "j:\pierre\Tempfile.xls", True
'request a name
newName = InputBox("New Reference Name in the database ?", "Rename new entry")
'rename the new entry as you wish
DoCmd.Rename newName, acTable, "New Reference"
'add the new reference to the references table
DoCmd.SetWarnings False
DoCmd.RunSQL ("insert into References_index(References) Values('" & newName & "')")
'delete the tempFile.xls
Set fso = CreateObject("Scripting.FileSystemObject")
fso.deletefile "J:\Pierre\Tempfile.xls"
DoCmd.SetWarnings True
MsgBox "New Reference added: " & Chr(13) & newName

voila. je vous met l'autre ou y a la macro excel mais c un peu complique parce que c pour une analyse de fichier XML bien particuliere.:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
 
'Initialize the sheet
If XL Is Nothing Then
    OpenXL
End If
XL.SheetsInNewWorkbook = 1
XL.Workbooks.Add
XL.Cells.Clear
'Here below is the list of known tags in the XML document to import
XL.Cells(1, 1).Value = "idnum"
XL.Cells(1, 2).Value = "location"
XL.Cells(1, 3).Value = "source"
XL.Cells(1, 4).Value = "field"
XL.Cells(1, 5).Value = "edit"
XL.Cells(1, 6).Value = "rank"
XL.Cells(1, 7).Value = "hw"
XL.Cells(1, 8).Value = "vg"
XL.Cells(1, 9).Value = "def"
XL.Cells(1, 10).Value = "rg"
XL.Cells(1, 11).Value = "ety"
'open File
Open Text1.Value For Input As #1
'read File
lineNumber = 1
continuation = False
Dim lineForContinuation As String
Dim tagForContinuation As String
Do Until EOF(1)
Line Input #1, Data
If XL.ExecuteExcel4Macro("Left(""" & Data & """, 4)") = "<en>" Then
'Starting on the second line  because the first one is for fields names
    lineNumber = lineNumber + 1
    columnNumber = 1
    continuation = False
'create a field if it does not exist
Else
If (XL.ExecuteExcel4Macro("Left(""" & Data & """, 1)") = "<" And continuation = False) Then
    endOfTag = InStr(Data, ">")
    startTag = XL.ExecuteExcel4Macro("Mid(""" & Data & """, 2, """ & endOfTag & """ - 2)")
    'the program goes back here if it adds a new field because it must explore the line then
addFieldLoop:
    'compare the tag to the fields name (1st line of the excel sheet)
    'first we have to find how many fields exists (1st row) because some fields might have been added
    continu = True
    g = 1
    fieldsTotal = 1
    Do While continu
        If XL.Cells(1, g).Value = "" Then
        fieldsTotal = g - 1
        continu = False
        Else
        g = g + 1
        End If
    Loop
    'now we check if a corresponding field exists (the case "cod" is added because this case is special (split in 3 fields))
    compareOK = False
    For i = 1 To fieldsTotal
        If startTag = XL.Cells(1, i).Value Or startTag = "cod" Then
            compareOK = True
            columnNumber = i
        End If
    Next i
    If compareOK Then
    'analyse the rest of data to find the ending tag (if not found then the next line will be the continuation) and to remove other existing tags
    endOfCurrentTag = 0
    currentLine = XL.ExecuteExcel4Macro("Right(""" & Data & """, """ & Len(Data) & """ - """ & endOfTag & """)")
endFinder:
    nextTagPosition = InStr(endOfCurrentTag + 1, currentLine, "<")
        If nextTagPosition = 0 Then
        'the end tag was not found and is in another line
        continuation = True
        tagForContinuation = startTag
        lineForContinuation = currentLine
        Else
        If (XL.ExecuteExcel4Macro("Mid(""" & currentLine & """, """ & nextTagPosition & """ + 1, 1) = ""/""") And XL.ExecuteExcel4Macro("Mid(""" & currentLine & """, """ & nextTagPosition & """ + 2, """ & Len(startTag) & """) = """ & startTag & """")) Then
        'the end tag is the one found and we have check that the name is ths same than ths starting tag
        currentLine = XL.ExecuteExcel4Macro("Left(""" & currentLine & """, """ & nextTagPosition & """ - 1)")
        continuation = False
        lineForContinuation = ""
        tagForContinuation = ""
        'the record is added
            If startTag <> "cod" Then
                XL.Cells(lineNumber, columnNumber).Value = currentLine
            Else
            'Here we analyse the code to slip it
               ' we have to skip in case the line is empty or else an error occures
                If currentLine = "" Or currentLine = "/" Then
                    GoTo jump
                Else
                    If XL.ExecuteExcel4Macro("Left(""" & currentLine & """, 1) = ""/""") Then
                    'just checking if the first character is a "/" and if so removing it
                        currentLine = XL.ExecuteExcel4Macro("Right(""" & currentLine & """, """ & Len(currentLine) & """ - 1)")
                    End If
 
                    If InStr(" & currentLine & ", "/") <> 0 Then
                        If XL.ExecuteExcel4Macro("Left(""" & currentLine & """, """ & InStr(currentLine, "/") & """ - 1)") = "B" _
                        Or XL.ExecuteExcel4Macro("Left(""" & currentLine & """, """ & InStr(currentLine, "/") & """ - 1)") = "D" _
                        Then
                            XL.Cells(lineNumber, 2).Value = XL.ExecuteExcel4Macro("Left(""" & currentLine & """, """ & InStr(currentLine, "/") & """ - 1)")
                            currentLine = XL.ExecuteExcel4Macro("Right(""" & currentLine & """, """ & Len(currentLine) & """ - """ & InStr(currentLine, "/") & """)")
                            If currentLine = "" Then
                            ' skip if empty line
                                GoTo jump
                            End If
                        End If
                    Else
                        If currentLine = "B" _
                        Or currentLine = "D" _
                        Then
                            XL.Cells(lineNumber, 2).Value = currentLine
                            'the currentline is obviously finished and there is no need to go further
                            GoTo jump
                        End If
                    End If
 
                    If InStr(currentLine, "/") <> 0 Then
                        If XL.ExecuteExcel4Macro("Left(""" & currentLine & """, """ & InStr(currentLine, "/") & """ - 1)") = "LONG" _
                        Or XL.ExecuteExcel4Macro("Left(""" & currentLine & """, """ & InStr(currentLine, "/") & """ - 1)") = "APA" _
                        Or XL.ExecuteExcel4Macro("Left(""" & currentLine & """, """ & InStr(currentLine, "/") & """ - 1)") = "THES" _
                        Or XL.ExecuteExcel4Macro("Left(""" & currentLine & """, """ & InStr(currentLine, "/") & """ - 1)") = "C" _
                        Or XL.ExecuteExcel4Macro("Left(""" & currentLine & """, """ & InStr(currentLine, "/") & """ - 1)") = "P" _
                        Or XL.ExecuteExcel4Macro("Left(""" & currentLine & """, """ & InStr(currentLine, "/") & """ - 1)") = "PC" _
                        Then
                            XL.Cells(lineNumber, 3).Value = XL.ExecuteExcel4Macro("Left(""" & currentLine & """, """ & InStr(currentLine, "/") & """ - 1)")
                            currentLine = XL.ExecuteExcel4Macro("Right(""" & currentLine & """, """ & Len(currentLine) & """ - """ & InStr(currentLine, "/") & """)")
                            If currentLine = "" Then
                            ' skip if empty line
                                GoTo jump
                            End If
                        End If
                        If XL.ExecuteExcel4Macro("Right(""" & currentLine & """, 1)") <> "/" Then
                            XL.Cells(lineNumber, 4).Value = currentLine
                        Else
                            XL.Cells(lineNumber, 4).Value = XL.ExecuteExcel4Macro("Left(""" & currentLine & """, """ & Len(currentLine) & """ - 1)")
                        End If
                    Else
                        If currentLine = "LONG" _
                        Or currentLine = "APA" _
                        Or currentLine = "THES" _
                        Or currentLine = "C" _
                        Or currentLine = "P" _
                        Or currentLine = "PC" _
                        Then
                            XL.Cells(lineNumber, 3).Value = currentLine
                            'the currentline is obviously finished and there is no need to go further
                            GoTo jump
                        End If
                        If XL.ExecuteExcel4Macro("Right(""" & currentLine & """, 1)") <> "/" Then
                            XL.Cells(lineNumber, 4).Value = currentLine
                        Else
                            XL.Cells(lineNumber, 4).Value = XL.ExecuteExcel4Macro("Left(""" & currentLine & """, """ & Len(currentLine) & """ - 1)")
                        End If
                    End If
jump:
                End If
            End If
        Else
        ' the tag is not the end so we keep searching for the next one in the line
        endOfCurrentTag = InStr(endOfCurrentTag + 1, currentLine, ">")
        GoTo endFinder
        End If
        End If
    Else
    'first we check it is really a new tag (not a comment or a ending tag)
    If (XL.ExecuteExcel4Macro("Left(""" & startTag & """, 1)") <> "/" And XL.ExecuteExcel4Macro("Left(""" & startTag & """, 1)") <> "!") Then
    'pop up window to ask if the tag unknown has to be add to the database
        addFieldPopUp = MsgBox("Unknown name : " & startTag & " Do you want to add it as a field ?", vbYesNo + vbExclamation + vbMsgBoxSetForeground, "Add field ?")
        If (addFieldPopUp = vbYes) Then
            Cells(1, fieldsTotal + 1).Value = startTag
            GoTo addFieldLoop
        End If
    End If
    End If
Else
'using the data as the continuation of the previous line
If continuation Then
'we will use the very same method than just above to find the tags
    startTag = tagForContinuation
    currentLine = lineForContinuation & " " & Data
    GoTo endFinder
End If
End If
End If
Loop
'close File
Close #1
'here the imporation can begin
'import the table
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "New Reference", XL.ActiveSheet, True
'request a name
newName = InputBox("New Reference Name in the database ?", "Rename new entry")
'rename the new entry as you wish
DoCmd.Rename newName, acTable, "New Reference"
'add the new reference to the references table
DoCmd.SetWarnings False
DoCmd.RunSQL ("insert into References_index(References) Values('" & newName & "')")
'delete the tempFile.xls
Set fso = CreateObject("Scripting.FileSystemObject")
fso.deletefile "J:\Pierre\Tempfile.xls"
DoCmd.SetWarnings True
'close XL now because there is no more use
CloseXL

Merci

[pgz]

Bonjour,

J'ai pas tout lu. Si!

J'ai cru comprendre que tu voulais attendre dans access que le fichier tempfile.xls soit créé.
2 solutions : ou tu le crées depuis access ou avant de l'utiliser tu testes si ce fichier est présent dans le répertoire!

Je ne sais pas si ça t'aide...

pgz

[random]

dans ta macro access tu rajoutes
do until 5=4
on error goto monlabel
ouverture temp
exit do
:monlabel
loop

[sharpeye]

Salut,

ben merci a tous les deux mais en fait ca me retire pas l erreur "Runtime error 3011" parce que j ai l impression que lors de l execution, si le fichier existe pas, il me sort l erreur meme avec un error catcher comme tu as fait.

Du coup, j en suis toujours au meme point.
PS : dans ta boucle, j ai mis une incremetation d'un entier pour faire un time out. C quand meme plus sur si jamais le fichier etait jamais creer :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 
n = 0
Do Until n>10000
On Error GoTo monlabel
'import the table
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "New Reference", "j:\pierre\Tempfile.xls", True
Exit Do
monlabel:
n = n + 1
Loop

++[/quote]

[random]

en fait tant que tu restes en mode test la gestion d'erreur n'est pas active
dans outil option il faut faire arrêt sur les erreurs non gérées

[sharpeye]

Je savais pas ca, mais j avais deja ce mode la selectionne donc ca vient pas de la.

[Osiris26]

Et si tu ajoute DoEvents dans un timer après ton Transferspreadsheet si tu connais à peu près combien de temps sa prends.

COmme :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
Dim PauseTime, Start
 
        PauseTime = 10    ' Définit la durée en secondes.
        Start = Timer    ' Définit l'heure de début.
        Do While Timer < Start + PauseTime
            DoEvents    ' Donne le contrôle à d'autres processus.
        Loop

[cafeine]

Une piste de réponse peut se trouver dans la création de Threads.

Un superbe exemple ici : http://access.developpez.com/sources...acc#creaThread

[sharpeye]

merci bien. je vais voir un peu ce que ca donne avec des threads. Sinon, pour le timer, le pb c que le temps depend beaucoup du nombre d entrees a importer. Pour le moment, j ai une autre facon d attendre, ca ouvre un pop up en attendant que excel execute tout, puis unefois fini, tu clque et voila.

PS : comment on tag resolu ?? Ya une option auelaue part ou faut changer le titre du sujet ?