Importation excel/access
Résolu/Fermé
fab101
Messages postés
139
Date d'inscription
samedi 12 juin 2004
Statut
Membre
Dernière intervention
27 septembre 2010
-
30 nov. 2004 à 11:33
altay0474 Messages postés 1 Date d'inscription mardi 3 juin 2008 Statut Membre Dernière intervention 3 juin 2008 - 3 juin 2008 à 19:09
altay0474 Messages postés 1 Date d'inscription mardi 3 juin 2008 Statut Membre Dernière intervention 3 juin 2008 - 3 juin 2008 à 19:09
A voir également:
- Importation excel/access
- Liste déroulante excel - Guide
- Si et excel - Guide
- Aller à la ligne excel - Guide
- Word et excel gratuit - Guide
- Mise en forme conditionnelle excel - Guide
13 réponses
Access considère une colonne d'excel comme un champs.
essai d'organiser un peu tes données sous ton fichier excel et sous Access 2000
avec un peu de chance en faisant Fichier/Données Externes/Importer avec une précision du type de fichier (Excel dans ton cas) tu auras au moins qqch. Bonne chance
essai d'organiser un peu tes données sous ton fichier excel et sous Access 2000
avec un peu de chance en faisant Fichier/Données Externes/Importer avec une précision du type de fichier (Excel dans ton cas) tu auras au moins qqch. Bonne chance
Kobaya
Messages postés
282
Date d'inscription
vendredi 28 mai 2004
Statut
Membre
Dernière intervention
10 janvier 2008
214
30 nov. 2004 à 12:26
30 nov. 2004 à 12:26
salut,
je n'ai pas touché ACCESS depuis un petit moment, mais je crois me rappeler qu'il y a une fonction pour importer automatiquement tout type de fichier de données (y compris Excel).
As-tu vu cette commande dans le menu?
A+.
je n'ai pas touché ACCESS depuis un petit moment, mais je crois me rappeler qu'il y a une fonction pour importer automatiquement tout type de fichier de données (y compris Excel).
As-tu vu cette commande dans le menu?
A+.
fab101
Messages postés
139
Date d'inscription
samedi 12 juin 2004
Statut
Membre
Dernière intervention
27 septembre 2010
2
30 nov. 2004 à 13:13
30 nov. 2004 à 13:13
oui
j'ai vu mais comme je l'ai marque mes données sont eparpillées donc je ne peux pas utiliser cette fonction
j'ai vu mais comme je l'ai marque mes données sont eparpillées donc je ne peux pas utiliser cette fonction
Bonjour,
Mon probléme c'est d'importer automatiquement une feuille Excell dans Access.Automatiquement , cad c'est quand je cilque sur un boutton "Importer" dans une interface d'Access, une fenêtre (comme celle dans l'enregistrement) s'ouvre et qui me permette de choisir le fichier à impoter.
Merci d'avance.
Mon probléme c'est d'importer automatiquement une feuille Excell dans Access.Automatiquement , cad c'est quand je cilque sur un boutton "Importer" dans une interface d'Access, une fenêtre (comme celle dans l'enregistrement) s'ouvre et qui me permette de choisir le fichier à impoter.
Merci d'avance.
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
J'ai le même souci: je recherche un exemple de code/macro sous access qui permettrait de customiser un peu l'importation de données; du style choisir quel colonne j'importe et où, quelle valeur je mets à partir de quelle source, etc...
fab101
Messages postés
139
Date d'inscription
samedi 12 juin 2004
Statut
Membre
Dernière intervention
27 septembre 2010
2
23 déc. 2004 à 16:05
23 déc. 2004 à 16:05
salut
explique un peu plus en detail stp
explique un peu plus en detail stp
Bonjour, moi g trouvé la solution à mon probléme(de l'importation) vous pouvez le trouvriez si vous voulez sur ce lien:
http://www.vbfrance.com/forum.v2.aspx?ID=351347
Merci
http://www.vbfrance.com/forum.v2.aspx?ID=351347
Merci
Bonjour, moi g resolu le probléme(de l'importation)
vous trouveriez la solution sur ce lien:
http://www.vbfrance.com/forum.v2.aspx?ID=351347
Merci
vous trouveriez la solution sur ce lien:
http://www.vbfrance.com/forum.v2.aspx?ID=351347
Merci
nbinfo2004
Messages postés
5
Date d'inscription
samedi 18 septembre 2004
Statut
Membre
Dernière intervention
25 décembre 2004
25 déc. 2004 à 14:22
25 déc. 2004 à 14:22
bonjour
essayer d'abord d'importer tes données dans une nouvelle table de ta base
ensuite essayer une reqeûte mise à jour basée sur ta nouvelle table
tiens moi au courant
a+
essayer d'abord d'importer tes données dans une nouvelle table de ta base
ensuite essayer une reqeûte mise à jour basée sur ta nouvelle table
tiens moi au courant
a+
J'ai créer des tables sous Excel et j'aimerais connaître la procédure pour passer ces données dans Access.
gr@nd@x
Messages postés
3
Date d'inscription
lundi 19 mars 2007
Statut
Membre
Dernière intervention
20 mars 2007
7
19 mars 2007 à 15:46
19 mars 2007 à 15:46
Bonjour
j'ai le problème suivant... j'ai un db existante sur access et je dois importer des données d'un fichier excel pour les insérer dans les tables access existantes.
j'ai déjà créer la liaison au fichier excel mais je bloque quand à la suite des opérations :/
Si vous savez m'aider, vous seriez tous des amours
j'ai le problème suivant... j'ai un db existante sur access et je dois importer des données d'un fichier excel pour les insérer dans les tables access existantes.
j'ai déjà créer la liaison au fichier excel mais je bloque quand à la suite des opérations :/
Si vous savez m'aider, vous seriez tous des amours
Bonjour,
j'ai un problème, je souhaite faire une liaison (mettre des données existantes qui sont dans Excel et les mettre dans Access) pour pouvoir gérer mes données bcp plus facilement. J'ai essayé de faire une importation de données externes mais Access n'accepte pas...
Est-ce que vous pourriez m'aider car c'est très urgent !
Merci d'avance.
Estelle
j'ai un problème, je souhaite faire une liaison (mettre des données existantes qui sont dans Excel et les mettre dans Access) pour pouvoir gérer mes données bcp plus facilement. J'ai essayé de faire une importation de données externes mais Access n'accepte pas...
Est-ce que vous pourriez m'aider car c'est très urgent !
Merci d'avance.
Estelle
altay0474
Messages postés
1
Date d'inscription
mardi 3 juin 2008
Statut
Membre
Dernière intervention
3 juin 2008
3 juin 2008 à 19:09
3 juin 2008 à 19:09
Bonjour tout le monde
Je possède de nombreux gros fichier Excel j’aimerai bien les mettre sous Access car apparemment avec Access la taille de mes fichier sera beaucoup moins important. Pour cela j’ai essayer d’importer mes fichier Excel vers Access avec ce que j’avais dans le menu Access le problème c’est que au lieu d’obtenir des fichiers plus petit au faite j’obtiens des fichiers Access 3 fois plus gros que le fichier original Excel.
De plus mes fichier Excel sont composée de plusieurs feuille et plusieurs tableaux avec ma méthode simple d’importation Access a du mal a les transfère et il m’affiche que des messages d’erreur.
Donc je ne sais pas trop comment faire j’ai trouvé 1 code sur le net mais comme je connais rien a VB je ne comprends rien !!!
C’est vraiment important que je trouve une solution a cela j’attends donc votre aide
' IMPORTER un modèle excel dans la table VEILLE
Public Function ImportExcelVeille(ByVal Filename As String) As Boolean
' objets OLE automation EXCEL
Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook, wsht As Excel.Worksheet
' Id_veille en cours (la clé primaire de la table), compte nb de lignes insérés, erreurs
Dim id_veille As Long, cptVeille As Long, cptErrors As Long
' tableau des noms de champs de la table
Dim EnTeteVeille As Variant
' collection des noms de champs/positions dans excel
Dim colPositionVeilles As New Collection
' ligne en cours
Dim Ligne As Long
' diverses variables temporaires
Dim Positions(50) As Long, LigneEncours As Variant, arrTemp As Variant
Dim blnTemp As Boolean, cptSuccessiveLignesVides As Long
Dim i As Long
On Error GoTo ImportExcelVeille_Error
DoCmd.Hourglass True
SysCmd acSysCmdSetStatus, "Importation..."
Set appExcel = New Excel.Application
' liste des champs attendus dans la table
EnTeteVeille = GetFields("VEILLE")
appExcel.Visible = False
Set wbk = appExcel.Workbooks.Open(Filename, ReadOnly:=True)
Set wsht = wbk.Worksheets(1)
Do ' boucle sur l'ensemble des lignes
' récupérer une ligne (non vide) dans le tableau temporaire :
Ligne = Ligne + 1
If GetExcelLine(wsht, Ligne, LigneEncours) Then
' si pas encore fait, d'abord chercher les entêtes de colonne:
If colPositionVeilles.Count = 0 Then
' si pas ou peu de correspondance, effacer la collection
If Not RetrouverChampsExcel(EnTeteVeille, LigneEncours, colPositionVeilles) _
Then Set colPositionVeilles = New Collection
'sinon traitement d'une ligne normale
Else
' récupérer les colonnes existantes à insérer sauf PK :
arrTemp = GenererTableauInsertion(EnTeteVeille, colPositionVeilles, _
LigneEncours, Array("Id_veille"))
' insérer le texte dans la table TEXTES - "Id_veille", Id_veille,
If FN_INSERT("VEILLE", arrTemp, "Id_veille", id_veille) _
Then cptVeille = cptVeille + 1 _
Else cptErrors = cptErrors + 1
End If
cptSuccessiveLignesVides = 0
Else ' compter les lignes vides successives
cptSuccessiveLignesVides = cptSuccessiveLignesVides + 1
End If
Loop Until cptSuccessiveLignesVides > 10 ' on quitte après 10 lignes vides
ImportExcelVeille = (cptVeille > 0)
ImportExcelVeille_Exit:
Set wsht = Nothing
Set wbk = Nothing
appExcel.Quit
Set appExcel = Nothing
SysCmd acSysCmdClearStatus
DoCmd.Hourglass False
Exit Function
ImportExcelVeille_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Function ImportExcelVeille of Module mdImportExcel", vbCritical
Resume ImportExcelVeille_Exit
End Function
' récupérer la liste des champs d'une table dans un tableau
Public Function GetFields(ByVal Tablename As String) As Variant
Dim oRS As DAO.Recordset, fld As DAO.Fields
Dim arrTemp() As String, i As Long
On Error GoTo GetFields_Error
Set oRS = CurrentDb.OpenRecordset(Tablename, dbOpenDynaset, dbSeeChanges)
ReDim arrTemp(oRS.Fields.Count - 1)
For i = 0 To oRS.Fields.Count - 1
arrTemp(i) = oRS.Fields(i).Name
Next i
GetFields = arrTemp
Exit Function
GetFields_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & _
") in Function GetFields of Module mdSql", vbCritical
End Function
Public Function ExistKey(ByVal key As String, ByVal col As Collection) As Boolean
Dim item As Variant
On Error GoTo KeyNotExists
item = col(key)
ExistKey = True
Exit Function
KeyNotExists:
ExistKey = False
End Function
' recherche d'un élément dans un tableau
Public Function look_in_array(Lookup As Variant, in_array As Variant, Optional _
ByRef Position As Long, Optional OptionBinaryCompare As Boolean = False) As _
Boolean
Dim i As Long
If IsArray(in_array) Then
For i = LBound(in_array) To UBound(in_array)
If (OptionBinaryCompare And Lookup = in_array(i)) Or (Not _
OptionBinaryCompare And Lookup Like in_array(i)) Then
Position = i
look_in_array = True
Exit Function
End If
Next i
End If
End Function
' récupérer une ligne du fichier Excel, compter les cases vides
' ligne considérée vide si moins de 5 cellules non vides.
Private Function GetExcelLine(ByVal sh As Worksheet, ByVal Ligne As Long, ByRef arrLigne As Variant) As Boolean
Dim i As Long, arrTemp() As String, CptEmptyCells As Long, cptSuccessiveEmptyCells As Long
ReDim arrTemp(50)
Do
i = i + 1
arrTemp(i) = sh.Cells(Ligne, i).Value
If IsEmpty(sh.Cells(Ligne, i).Value) Then
CptEmptyCells = CptEmptyCells + 1
cptSuccessiveEmptyCells = cptSuccessiveEmptyCells + 1
Else
cptSuccessiveEmptyCells = 0
End If
Loop Until cptSuccessiveEmptyCells >= 10 Or i >= 50
ReDim Preserve arrTemp(i - cptSuccessiveEmptyCells)
arrLigne = arrTemp
GetExcelLine = (i - CptEmptyCells > 5)
End Function
' générer le tableau des champs à insérer
Private Function GenererTableauInsertion(ByVal EnTetes, ByVal colPositions As Collection, _
ByVal LigneEncours, Optional ByVal Exceptions)
Dim arrTemp() As String, i As Long
ReDim arrTemp(0)
If IsMissing(Exceptions) Or Not IsArray(Exceptions) Then
For i = LBound(EnTetes) To UBound(EnTetes)
If ExistKey(EnTetes(i), colPositions) Then
ReDim Preserve arrTemp(UBound(arrTemp) + 2)
arrTemp(UBound(arrTemp) - 2) = EnTetes(i)
arrTemp(UBound(arrTemp) - 1) = LigneEncours(colPositions(EnTetes(i)))
End If
Next i
Else
For i = LBound(EnTetes) To UBound(EnTetes)
If Not look_in_array(EnTetes(i), Exceptions) And ExistKey(EnTetes(i), colPositions) Then
ReDim Preserve arrTemp(UBound(arrTemp) + 2)
arrTemp(UBound(arrTemp) - 2) = EnTetes(i)
arrTemp(UBound(arrTemp) - 1) = LigneEncours(colPositions(EnTetes(i)))
End If
Next i
End If
GenererTableauInsertion = arrTemp
End Function
' obtenir la correspondance champs Excel/champs table
Private Function RetrouverChampsExcel(ByVal ListFields, ByVal LigneEncours, ByRef colPosition As Collection) As Boolean
Dim i As Long, lngPosition As Long
Dim lngFound As Long
Set colPosition = New Collection ' vider la collection
' on récupère les positions des colonnes de la table textes
For i = LBound(LigneEncours) To UBound(LigneEncours)
If look_in_array(LigneEncours(i), ListFields, lngPosition) Then
colPosition.Add i, ListFields(lngPosition)
lngFound = lngFound + 1
End If
Next i
' retourner TRUE si au moins 5 des champs de la table ont été retrouvés
RetrouverChampsExcel = lngFound >= 5
End Function
' insertion via objet ADO: Tablename = table de destination
' InsertValues = (champ1, valeur1, champ2, valeur2, etc)
Public Function FN_INSERT(ByVal Tablename As String, ByVal InsertValues As _
Variant, Optional ByVal InsertIdFilename As String = "", Optional ByRef _
InsertIdValue As Long) As Boolean
Dim oRS As DAO.Recordset, i As Long
On Error GoTo FN_INSERT_Error
Set oRS = CurrentDb.OpenRecordset(Tablename, dbOpenDynaset, dbSeeChanges)
With oRS
' nécessaire pour ajouter à la fin, sinon écrase l'enregistrement en cours.
If Not .EOF Then .MoveLast
.AddNew
For i = LBound(InsertValues) To UBound(InsertValues) - 1 Step 2
If Not IsEmpty(InsertValues(i + 1)) Then
Select Case .Fields(InsertValues(i)).Type
Case adDate, adDBDate, adDBTime, adDBTimeStamp
.Fields(InsertValues(i)).Value = CDate(Replace(InsertValues(i + _
1), "'", ""))
Case Else
.Fields(InsertValues(i)).Value = InsertValues(i + 1)
End Select
End If
Next i
.Update
If InsertIdFilename <> "" Then .Move 0, .LastModified: InsertIdValue = _
.Fields(InsertIdFilename).Value
.Close
End With
FN_INSERT = True
Exit Function
FN_INSERT_Error:
If Err.Number = 3421 Then
MsgBox "Donnée de type incorrect, colonne: " & InsertValues(i) & " = " & _
InsertValues(i + 1) & vbCrLf & "Error " & Err.Number & " (" & _
Err.Description & ") in Function FN_INSERT of Module mdSql", vbCritical
Else
MsgBox "Error " & Err.Number & " (" & Err.Description & _
") in Function FN_INSERT of Module mdSql", vbCritical
End If
End Function
Je vous remercie d’avance
Altay
Je possède de nombreux gros fichier Excel j’aimerai bien les mettre sous Access car apparemment avec Access la taille de mes fichier sera beaucoup moins important. Pour cela j’ai essayer d’importer mes fichier Excel vers Access avec ce que j’avais dans le menu Access le problème c’est que au lieu d’obtenir des fichiers plus petit au faite j’obtiens des fichiers Access 3 fois plus gros que le fichier original Excel.
De plus mes fichier Excel sont composée de plusieurs feuille et plusieurs tableaux avec ma méthode simple d’importation Access a du mal a les transfère et il m’affiche que des messages d’erreur.
Donc je ne sais pas trop comment faire j’ai trouvé 1 code sur le net mais comme je connais rien a VB je ne comprends rien !!!
C’est vraiment important que je trouve une solution a cela j’attends donc votre aide
' IMPORTER un modèle excel dans la table VEILLE
Public Function ImportExcelVeille(ByVal Filename As String) As Boolean
' objets OLE automation EXCEL
Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook, wsht As Excel.Worksheet
' Id_veille en cours (la clé primaire de la table), compte nb de lignes insérés, erreurs
Dim id_veille As Long, cptVeille As Long, cptErrors As Long
' tableau des noms de champs de la table
Dim EnTeteVeille As Variant
' collection des noms de champs/positions dans excel
Dim colPositionVeilles As New Collection
' ligne en cours
Dim Ligne As Long
' diverses variables temporaires
Dim Positions(50) As Long, LigneEncours As Variant, arrTemp As Variant
Dim blnTemp As Boolean, cptSuccessiveLignesVides As Long
Dim i As Long
On Error GoTo ImportExcelVeille_Error
DoCmd.Hourglass True
SysCmd acSysCmdSetStatus, "Importation..."
Set appExcel = New Excel.Application
' liste des champs attendus dans la table
EnTeteVeille = GetFields("VEILLE")
appExcel.Visible = False
Set wbk = appExcel.Workbooks.Open(Filename, ReadOnly:=True)
Set wsht = wbk.Worksheets(1)
Do ' boucle sur l'ensemble des lignes
' récupérer une ligne (non vide) dans le tableau temporaire :
Ligne = Ligne + 1
If GetExcelLine(wsht, Ligne, LigneEncours) Then
' si pas encore fait, d'abord chercher les entêtes de colonne:
If colPositionVeilles.Count = 0 Then
' si pas ou peu de correspondance, effacer la collection
If Not RetrouverChampsExcel(EnTeteVeille, LigneEncours, colPositionVeilles) _
Then Set colPositionVeilles = New Collection
'sinon traitement d'une ligne normale
Else
' récupérer les colonnes existantes à insérer sauf PK :
arrTemp = GenererTableauInsertion(EnTeteVeille, colPositionVeilles, _
LigneEncours, Array("Id_veille"))
' insérer le texte dans la table TEXTES - "Id_veille", Id_veille,
If FN_INSERT("VEILLE", arrTemp, "Id_veille", id_veille) _
Then cptVeille = cptVeille + 1 _
Else cptErrors = cptErrors + 1
End If
cptSuccessiveLignesVides = 0
Else ' compter les lignes vides successives
cptSuccessiveLignesVides = cptSuccessiveLignesVides + 1
End If
Loop Until cptSuccessiveLignesVides > 10 ' on quitte après 10 lignes vides
ImportExcelVeille = (cptVeille > 0)
ImportExcelVeille_Exit:
Set wsht = Nothing
Set wbk = Nothing
appExcel.Quit
Set appExcel = Nothing
SysCmd acSysCmdClearStatus
DoCmd.Hourglass False
Exit Function
ImportExcelVeille_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Function ImportExcelVeille of Module mdImportExcel", vbCritical
Resume ImportExcelVeille_Exit
End Function
' récupérer la liste des champs d'une table dans un tableau
Public Function GetFields(ByVal Tablename As String) As Variant
Dim oRS As DAO.Recordset, fld As DAO.Fields
Dim arrTemp() As String, i As Long
On Error GoTo GetFields_Error
Set oRS = CurrentDb.OpenRecordset(Tablename, dbOpenDynaset, dbSeeChanges)
ReDim arrTemp(oRS.Fields.Count - 1)
For i = 0 To oRS.Fields.Count - 1
arrTemp(i) = oRS.Fields(i).Name
Next i
GetFields = arrTemp
Exit Function
GetFields_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & _
") in Function GetFields of Module mdSql", vbCritical
End Function
Public Function ExistKey(ByVal key As String, ByVal col As Collection) As Boolean
Dim item As Variant
On Error GoTo KeyNotExists
item = col(key)
ExistKey = True
Exit Function
KeyNotExists:
ExistKey = False
End Function
' recherche d'un élément dans un tableau
Public Function look_in_array(Lookup As Variant, in_array As Variant, Optional _
ByRef Position As Long, Optional OptionBinaryCompare As Boolean = False) As _
Boolean
Dim i As Long
If IsArray(in_array) Then
For i = LBound(in_array) To UBound(in_array)
If (OptionBinaryCompare And Lookup = in_array(i)) Or (Not _
OptionBinaryCompare And Lookup Like in_array(i)) Then
Position = i
look_in_array = True
Exit Function
End If
Next i
End If
End Function
' récupérer une ligne du fichier Excel, compter les cases vides
' ligne considérée vide si moins de 5 cellules non vides.
Private Function GetExcelLine(ByVal sh As Worksheet, ByVal Ligne As Long, ByRef arrLigne As Variant) As Boolean
Dim i As Long, arrTemp() As String, CptEmptyCells As Long, cptSuccessiveEmptyCells As Long
ReDim arrTemp(50)
Do
i = i + 1
arrTemp(i) = sh.Cells(Ligne, i).Value
If IsEmpty(sh.Cells(Ligne, i).Value) Then
CptEmptyCells = CptEmptyCells + 1
cptSuccessiveEmptyCells = cptSuccessiveEmptyCells + 1
Else
cptSuccessiveEmptyCells = 0
End If
Loop Until cptSuccessiveEmptyCells >= 10 Or i >= 50
ReDim Preserve arrTemp(i - cptSuccessiveEmptyCells)
arrLigne = arrTemp
GetExcelLine = (i - CptEmptyCells > 5)
End Function
' générer le tableau des champs à insérer
Private Function GenererTableauInsertion(ByVal EnTetes, ByVal colPositions As Collection, _
ByVal LigneEncours, Optional ByVal Exceptions)
Dim arrTemp() As String, i As Long
ReDim arrTemp(0)
If IsMissing(Exceptions) Or Not IsArray(Exceptions) Then
For i = LBound(EnTetes) To UBound(EnTetes)
If ExistKey(EnTetes(i), colPositions) Then
ReDim Preserve arrTemp(UBound(arrTemp) + 2)
arrTemp(UBound(arrTemp) - 2) = EnTetes(i)
arrTemp(UBound(arrTemp) - 1) = LigneEncours(colPositions(EnTetes(i)))
End If
Next i
Else
For i = LBound(EnTetes) To UBound(EnTetes)
If Not look_in_array(EnTetes(i), Exceptions) And ExistKey(EnTetes(i), colPositions) Then
ReDim Preserve arrTemp(UBound(arrTemp) + 2)
arrTemp(UBound(arrTemp) - 2) = EnTetes(i)
arrTemp(UBound(arrTemp) - 1) = LigneEncours(colPositions(EnTetes(i)))
End If
Next i
End If
GenererTableauInsertion = arrTemp
End Function
' obtenir la correspondance champs Excel/champs table
Private Function RetrouverChampsExcel(ByVal ListFields, ByVal LigneEncours, ByRef colPosition As Collection) As Boolean
Dim i As Long, lngPosition As Long
Dim lngFound As Long
Set colPosition = New Collection ' vider la collection
' on récupère les positions des colonnes de la table textes
For i = LBound(LigneEncours) To UBound(LigneEncours)
If look_in_array(LigneEncours(i), ListFields, lngPosition) Then
colPosition.Add i, ListFields(lngPosition)
lngFound = lngFound + 1
End If
Next i
' retourner TRUE si au moins 5 des champs de la table ont été retrouvés
RetrouverChampsExcel = lngFound >= 5
End Function
' insertion via objet ADO: Tablename = table de destination
' InsertValues = (champ1, valeur1, champ2, valeur2, etc)
Public Function FN_INSERT(ByVal Tablename As String, ByVal InsertValues As _
Variant, Optional ByVal InsertIdFilename As String = "", Optional ByRef _
InsertIdValue As Long) As Boolean
Dim oRS As DAO.Recordset, i As Long
On Error GoTo FN_INSERT_Error
Set oRS = CurrentDb.OpenRecordset(Tablename, dbOpenDynaset, dbSeeChanges)
With oRS
' nécessaire pour ajouter à la fin, sinon écrase l'enregistrement en cours.
If Not .EOF Then .MoveLast
.AddNew
For i = LBound(InsertValues) To UBound(InsertValues) - 1 Step 2
If Not IsEmpty(InsertValues(i + 1)) Then
Select Case .Fields(InsertValues(i)).Type
Case adDate, adDBDate, adDBTime, adDBTimeStamp
.Fields(InsertValues(i)).Value = CDate(Replace(InsertValues(i + _
1), "'", ""))
Case Else
.Fields(InsertValues(i)).Value = InsertValues(i + 1)
End Select
End If
Next i
.Update
If InsertIdFilename <> "" Then .Move 0, .LastModified: InsertIdValue = _
.Fields(InsertIdFilename).Value
.Close
End With
FN_INSERT = True
Exit Function
FN_INSERT_Error:
If Err.Number = 3421 Then
MsgBox "Donnée de type incorrect, colonne: " & InsertValues(i) & " = " & _
InsertValues(i + 1) & vbCrLf & "Error " & Err.Number & " (" & _
Err.Description & ") in Function FN_INSERT of Module mdSql", vbCritical
Else
MsgBox "Error " & Err.Number & " (" & Err.Description & _
") in Function FN_INSERT of Module mdSql", vbCritical
End If
End Function
Je vous remercie d’avance
Altay