Discussion :

[jpb38]

Bonjour à tous (toutes),

J'ai besoin de votre expertise pour importer (ou attacher, peu importe) toutes les feuilles d'un classeur Excel dans Access97.
En soit, celà ne parait pas très compliqué.
Le problème est que je ne connais ni le nombre de feuilles du classeur, ni leurs noms, et le nombre et les noms peuvent changer au cours du temps.
Je cherche donc à créer, en automatique, autant de tables Access que de feuilles.

Avez-vous une idée du comment faire?

Par avance merci

Jean-Pascal

[helas]

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
 
Sub Importation_Excel()
 
 On Error GoTo erreur
 
 Dim xlA As Object, xlW As Object
 Dim repertoire As String, fichier As String
 Dim feuille() As String, i As Long, n As Long
 
 Set xlA = CreateObject("excel.application")
 xlA.Visible = True
 repertoire = "d:\chemin\"
 fichier = "test.xls"
 
 xlA.workbooks.Open (repertoire & fichier)   'ouverture du fichier
 Set xlW = xlA.activeworkbook
 ReDim feuille(10)
 n = xlW.sheets.Count
 For i = 1 To n
   If i Mod 10 = 0 Then ReDim Preserve feuille(i + 10)
   feuille(i) = xlW.sheets(i).Name    'récupération du nom des onglets
 Next i
 
 Set xlW = Nothing
 xlA.activeworkbook.Close acQuitSaveNone   'fermeture du fichier
 xlA.Quit
 Set xlA = Nothing
 
 rem *** Importation des onglets ****
 For i = 1 To n
  If ExisteTable(feuille(i)) Then DoCmd.DeleteObject acTable, feuille(i)
  DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, feuille(i), repertoire & fichier, False, feuille(i) & "!", False
 Next i
 
 Exit Sub
erreur:
 
End Sub
 
 
Function ExisteTable(s As String) As Boolean
 On Error GoTo erreur
 ExisteTable = False
 If CurrentDb.TableDefs(s).Name = s Then ExisteTable = True
 Exit Function
erreur:
End Function

[jpb38]

C'est exactement ce que je cherchais.

Merci

Jean-Pascal