' #INDEX# =======================================================================================================================
' Title .........: xlsimport_helper
' Version ...... : 1.0
' Language ......: French
' Description ...:
'améliorer ses importations sous access :
'Problème bien connu.
'Lors de l'import il analyse les première ligne, si il détecte des champs de moins de 256 caractères il considère que c'est du texte. Tu dois être dans ce cas là.
'
'Solution 1:
'Importer dans une table où les champs ont le bon type. (Changer le type de la colonne dans la table déjà créé lors de l'import).
'
'Solution 2:
'Organiser tes lignes pour que les contenus les plus important sur ce champ soit en premier.
'
'voici une classe, dans l'esprit de la solution 2, qui nous affranchit des manipulations sur le fichier source
' Author(s) .....: martinbrait

'FONCTIONNEMENT :
'dans une créatable access temporaire, de son choix.
'en second paramètre, on envoie la succession,
'séparée par des points virgules, de tous les
'types explicites, correspondant à toutes les colonnes à
'importer. Une ligne fictive sera produite avec les typages,
'puis après l'importation, une requête access supprimera
'la ligne fictive.
'la règle est de déclarer au moins un contenu texte "lignefictive",
'lors de l'importation, et de filtrer la destruction de la première
'ligne par automate dao
'le principe est de systématiquement forcer et remplir intégralement, le contenu de la première ligne
' ===============================================================================================================================

' #FUNCTION# ====================================================================================================================
' Name...........: IntegrerUnFichierXls(NomTableCible As String, PathXlsSource As String, Types As String)
' Description ...: Fiabilise les programmes d'importation xls->access, depuis access
' Syntax.........: IntegrerUnFichierXls(NomTableCible As String, PathXlsSource As String, Types As String)
' Parameters ....: NomTableCible As String, précisez ici le nom de votre table temporaire qui sera créée sous access
' PathXlsSource As String, le chemin du classeur xls à importer
'Types As String, ligne de typages forts, séparés par des points virgules.'
'vous pouvez la remplir partiellement, entrecoupée de vides, ou incomplète
' Return values .: Void
' Author ........: martinbrait
' Modified.......:
' Remarks .......: La première ligne du fichier xls, DOIT contenir les noms de colonnes
'IMPORTATION FIABILISEE XLS->ACCESS
'garantit notamment une importation parfaite des champs MEMO sans troncature
'Apportez vos améliorations !!!


'exemple date;memo;text50;text255
'-> deviendra ligne fictive au moment de l'intégration
'01/01/1900;mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm;tttttttttttttttttttttttttttttttttttt;tttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttt

'vous pouvez écrire également le typage uniquement sur les colonnes memo ou autres ambigüités
';;;memo;;integer 'la colonne 4 sera typée memo

'le classeur excel à importer contient une seule feuille d'intégration, active (index 1)
'cherche théoriquement un contenu de tableau sur 100 colonnes, en rapatriant tantôt
'les propositions de typage explicite en paramètre,tantôt le typage naturel sur les deux lignes suivantes



'=======================================================
'=======================================================
' exemple à copier dans un module bacasable:

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
'chargement de la classe
Private xli As New xlsimport_helper
Private Sub ExempleDutilisation()
'Soyez vigilant sur l'orthographe en rédigeant vos paramètres de colonnes !!
'par confort,on va prendre le typage du contenu en dessous, si autres colonnes existantes
'pour lesquelles le typage est déduit sans difficulté.
 
'strpath = "c:\temp\test"
'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "EXPORT-UO", strpath, True
Call xli.IntegrerUnFichierXls("doudou", "c:\temp\test.xls", "text8;date;integer;integer;integer;text8;date;text3;text20;text50;memo")
End Sub

'=======================================================
'=======================================================
'à copier dans une classe xlsimport_helper
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
Public Sub IntegrerUnFichierXls(NomTableCible As String, PathXlsSource As String, Types As String, Optional AvecNotification As Boolean = False)
 
Dim sTypes As String
Dim aTypes As Variant
Dim strmemo As String, strtext As String
Dim repeater As Integer, iNbCol As Integer
Dim i As Integer, j As Integer
Dim infouser As Variant
 
 
'initialisations :
strmemo = ""
strtext = ""
 
'initialisation
For i = 1 To 256
strmemo = strmemo & "m"
Next
 
    Dim xlApp As Excel.Application
    Dim xlSheet As Excel.Worksheet
    Dim xlBook As Excel.Workbook
 
sTypes = Replace(Types, "text", "t") 'on devra, dans un second passage déclarer le nombre de caractères choisis
 
aTypes = Split(sTypes, ";")
iNbCol = UBound(aTypes)
 
For i = LBound(aTypes) To iNbCol
    If Left(aTypes(i), 1) = "t" Then
    repeater = Int(Replace(aTypes(i), "t", ""))
 
    For j = 1 To repeater
    strtext = strtext & "t"
    Next
 
    'on actualise le contenu de la colonne considérée,
    'filtrée exclusivement sur du contenu texte;
    'on remplace le contenu entier !!!
    aTypes(i) = Replace(aTypes(i), aTypes(i), strtext)
 
    Else
    'tous les autres types concernant les colonnes
 
    'dès que l'on détecte "memo", entre points virgules,
    'on le remplace par un contenu de 256 caractères
    aTypes(i) = Replace(aTypes(i), "memo", strmemo)
    aTypes(i) = Replace(aTypes(i), "date", "01/01/1900")
 
    End If
    'puis on réinitialise strtext, avant de poursuivre la boucle
    strtext = ""
Next
 
'on prévoit un remplacement de contenu pour les champs,
'qui viendra s'implanter en première ligne d'importation
'du fichier excel.
 
  'ouverture du classeur, Initialisations
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Open(PathXlsSource)
 
'on garantit que l'importation se passera bien, également pour l'importation des dates,
'en décochant systématiquement l'option d'affichage xls valeur zéro
xlApp.ActiveWindow.DisplayZeros = False
 
 
    xlApp.Visible = False
 
''se positionner sur la feuille active pour y insérer la ligne prévue pour contenu fictif
        With xlBook.ActiveSheet
                .Rows("2:2").Insert Shift:=xlDown
        End With
 
    'écriture de la première ligne technique
    For i = 1 To iNbCol + 1
    xlBook.ActiveSheet.Cells(2, i).value = aTypes(i - 1) 'sans précision option base, commence à 0
    Next
 
    'on connaît et on limite le nombre de colonnes fortement typées,reçu en paramèter de la fonction,
    'mais on a le luxe de dépasser par sécurité le nombre de colonnes
    'un passage de confort, pour admettre le typage explicite facultatif
    For i = 1 To 100
        If i <= iNbCol + 1 Then
            On Error Resume Next 'pour ne pas faire tomber le programme
            If Len(aTypes(i - 1)) > 0 Then
            xlBook.ActiveSheet.Cells(2, i).value = aTypes(i - 1) 'sans précision option base, commence à 0
            Else
            'on récupère le contenu de la ligne 3, ou 4, selon la présence de contenu
                If Len(xlBook.ActiveSheet.Cells(3, i).value) > 0 Then
                    xlBook.ActiveSheet.Cells(2, i).value = xlBook.ActiveSheet.Cells(3, i).value
                    ElseIf Len(xlBook.ActiveSheet.Cells(3, i).value) = 0 Then
                    xlBook.ActiveSheet.Cells(2, i).value = xlBook.ActiveSheet.Cells(4, i).value
                End If
            End If
        Else
            'on récupère le contenu de la ligne 3, systématiquement, dès que les colonnes en retypage sont traitées
            xlBook.ActiveSheet.Cells(2, i).value = xlBook.ActiveSheet.Cells(3, i).value
        End If
    Next
 
            xlApp.ActiveWorkbook.Save
            Set xlSheet = Nothing
            xlApp.Quit
            Set xlApp = Nothing
 
'=========================================
'importation proprement dite, sous access
'à adapter selon sa version (2003,2010 etc...)
'==========================================
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, NomTableCible, PathXlsSource, True
 
'et suppression de la ligne technique devenue inutile
Call SuppressionDePremiereLigne(NomTableCible)
 
If AvecNotification = True Then
infouser = MsgBox("Le fichier " & PathXlsSource & vbCrLf & "a été intégré dans la table " & NomTableCible, vbInformation, "OK")
End If
End Sub
 
 
Private Function SuppressionDePremiereLigne(NomTableCible As String)
    Dim db As Database
    Dim strSQL As String
 
    Set db = CurrentDb
    strSQL = _
"Delete from " & _
"( " & _
" select  top 1 '" & NomDeColonne(NomTableCible, 1) & "' from '" & NomTableCible & _
") "
 
    db.Execute (strSQL)
    db.Close
End Function
 
 
Private Function NomDeColonne(NomTable As String, NumCol As Integer)
Dim i As Integer
i = 1
Set db = CurrentDb()
Set rs1 = db.OpenRecordset(NomTable)
Dim fld As DAO.Field
For Each fld In rs1.Fields
    If i = NumCol Then
    NomDeColonne = fld.Name
    Exit For
    End If
i = i + 1
Next
Set fld = Nothing
End Function