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
| Private Sub btnImport_Click()
On Error GoTo Err_btnImport_Click
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim oApp As Excel.Application
Dim oWkb As Excel.Workbook
Dim oWSht As Excel.Worksheet
Dim i As Long, loStop As Long, loLignePasVide As Long
Dim strFeuille As String, strChemin As String, strColonne1 As String, strColonne2 As String
Dim strLink As String, strSection As String, strNiveau2 As String, strNiveau3 As String
'Inscrire le nom du fichier choisi et son chemin
DoCmd.Hourglass True
strChemin = Parcourir
'Si aucun fichier choisi
If strChemin = "" Then: Exit Sub
'Le nom de ta feuille étant NAF j'ai inscrit directement dans le code.
'Il serait possible de choisir le nom de la feuille et de le passer dans la variable
strFeuille = "NAF"
'Créer l'objet Excel
Set oApp = CreateObject("excel.application")
'Récupérer le fichier
Set oWkb = oApp.Workbooks.Open(strChemin)
'Récupérer la bonne feuille
Set oWSht = oWkb.Worksheets(strFeuille)
'Créer le record
Set db = CurrentDb
Set rst = db.OpenRecordset("SELECT T_Code_APE.APE_Link, T_Code_APE.Code_APE, T_Code_APE.Description FROM T_Code_APE;")
'Première ligne d'importation à 3 selon ton fichier
loLignePasVide = 0
For i = 3 To 65536 'Nombre maximum de ligne d'une feuille Excel en version 32 bytes
If oWSht.Range("A" & i).Value <> "" Then
loStop = 0 'Remettre le stop de la boucle à 0
loLignePasVide = loLignePasVide + 1
'On ajoute une ligne premier niveau dans la table
strColonne1 = Trim(oWSht.cells(i, 1))
If Left(strColonne1, 7) = "SECTION" Then
strLink = "0"
strSection = strColonne1 'On inscrit ce qui fera le lien pour la section
strColonne2 = oWSht.cells(i, 2)
'On ajoute une ligne deuxième niveau dans la table
ElseIf InStr(1, strColonne1, ".") = 0 Then
strLink = strSection
strNiveau2 = strColonne1 'On inscrit ce qui fera le lien pour le deuxième niveau
strColonne2 = oWSht.cells(i, 2)
'On ajoute une ligne troisième ou quatirème niveau
ElseIf InStr(1, strColonne1, ".") > 0 Then
'Ici troisième niveau
If Len(Mid(oWSht.cells(i, 1), 3)) = 2 Then
strLink = strNiveau2
strNiveau3 = strColonne1 'On inscrit ce qui fera le lien pour le deuxième niveau
strColonne2 = oWSht.cells(i, 2)
'ici quatrième niveau
Else
strLink = strNiveau3
strColonne2 = oWSht.cells(i, 2)
End If
End If
rst.AddNew
rst("APE_Link") = strLink
rst("Code_APE") = strColonne1
rst("Description") = strColonne2
rst.Update
Else
loStop = loStop + 1
End If
If loStop = 4 Then: Exit For 'Si on a passé 5 lignes sans données on sort de la boucle
Next i
rst.Close
Set rst = Nothing
Set db = Nothing
oWkb.Close
Set oWSht = Nothing
Set oWkb = Nothing
Set oApp = Nothing
DoCmd.Hourglass False
MsgBox "Vous venez d'insérer " & loLignePasVide & " lignes dans la table T_Code_APE"
Exit_btnImport_Click:
Exit Sub
Err_btnImport_Click:
MsgBox Err.Description & "# erreur: " & Err.Number
Resume Exit_btnImport_Click
End Sub |
