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
| Sub ImporterCmdes()
Dim oApp As Excel.Application
Dim oWkb As Excel.Workbook
Dim oWSht As Excel.Worksheet
Dim i As Long, strTrc As String
Dim db As DAO.Database, rsDest As DAO.Recordset
Dim fDlg As Office.FileDialog, strFichier As String
On Error GoTo ErrH:
' --------------------------
' Selection du fichier Excel
' --------------------------
Set fDlg = Application.FileDialog(msoFileDialogOpen)
' Définition du ou des filtres
fDlg.Filters.Clear
fDlg.Filters.Add "Fichier Excel", "*.xl*"
' Dossier de départ
fDlg.InitialFileName = CurrentProject.Path
' Type d'affichage
fDlg.InitialView = msoFileDialogViewList
If fDlg.Show Then
strFichier = fDlg.SelectedItems(1)
End If
Set fDlg = Nothing
' Si l'utilisateur a cliqué sur Annuler quitter la procédure
If Len(strFichier) = 0 Then Exit Sub
' --------------------------
' Ouverture du fichier Excel
' --------------------------
Set oApp = CreateObject("excel.application")
Set oWkb = oApp.Workbooks.Open(strFichier) 'Fichier sélectionné par l'utilisateur
Set oWSht = oWkb.Worksheets("Feuil1") 'mettez ici le nom de la feuille qui contient les données à importer
' On ouvre un recordset sur la table dans laquelle on veut
' ajouter des enregistrements
Set db = CurrentDb
Set rsDest = db.OpenRecordset("tblCmdes", dbOpenDynaset)
'première ligne ou commence l'import
i = 11
'Tant que la colonne 1 (A) n'est pas vide
While Len(oWSht.Cells(i, 1).Text) > 0
'condition de remplissage de la table => eviter les doublons
'si l'enregistrement existe déjà dans la table destination,
'on passe à la ligne suivante sans l'importer
If DCount("*", "[tblCmdes]", "[NumCmde] = " & oWSht.Cells(i, 1)) = 0 Then
'le numéro 1 correspond au numéro de la colonne source, tel que : A=1, B=2, C=3 ...
rsDest.AddNew
strTrc = "Champ [NumCmde]"
rsDest("NumCmde") = oWSht.Cells(i, 1)
strTrc = "Champ [CodeClient]"
rsDest("CodeClient") = oWSht.Cells(i, 2)
strTrc = "Champ [NumEmploye]"
rsDest("NumEmploye") = oWSht.Cells(i, 3)
strTrc = "Champ [DateCmde]"
rsDest("DateCmde") = oWSht.Cells(i, 4)
strTrc = "Champ [À livrer avant]"
rsDest("À livrer avant") = oWSht.Cells(i, 5)
strTrc = "Champ [DateEnvoi]"
rsDest("DateEnvoi") = oWSht.Cells(i, 6)
strTrc = "Champ [NumMessager]"
rsDest("NumMessager") = oWSht.Cells(i, 7)
strTrc = "Champ [NumCmPortde]"
rsDest("Port") = oWSht.Cells(i, 8)
strTrc = "Sauver Nouvel Enregistrement"
rsDest.Update
End If
strTrc = ""
'on incrémente la variable i pour passer à la ligne suivante
i = i + 1
Wend
Sortie:
Set oWSht = Nothing
If Not (oWkb Is Nothing) Then oWkb.Close False
Set oWkb = Nothing
If Not (oApp Is Nothing) Then oApp.Quit
Set oApp = Nothing
If Not (rsDest Is Nothing) Then rsDest.Close
Exit Sub
ErrH:
Select Case Err.Number
Case 3022 ' Risque de doublon - Violation Clé/Index unique
' on annule l'ajout et on continue
rsDest.CancelUpdate
Resume Next
' Erreur ignorées. Pour les prendre en compte, mettre en commentaire
' l'instruction Resume Next
Case 3163 ' Le champ est trop petit pour accepter la quantité de données que vous voulez ajouter
Resume Next
Case 3349 ' Dépassement de capacité sur un champ numérique
Resume Next
Case 3421 ' Erreur de conversion de type
Resume Next
End Select
MsgBox "Erreur No. " & Err.Number & " : " & Err.Description, , _
"Ligne " & i & ". " & strTrc
Resume Sortie
End Sub |
Partager