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
|
Dim oApp As Excel.Application
Dim oWkb As Excel.Workbook
Dim oWSht As Excel.Worksheet
On Error Resume Next
'-----------------------------------------------------------------------------
Dim Cn As ADODB.Connection
Dim oCat As ADOX.Catalog
Dim Fichier As String
Dim Feuille As ADOX.Table
Dim nblig As String
Dim fd As Office.FileDialog
' Créer un objet FileDialog
Set fd = Application.FileDialog(msoFileDialogOpen)
' Titre de la boîte de dialogue
fd.title = "Sélectionnez le fichier - monfichier.xls -"
' Ne pas autoriser la sélection multiple
' (donc 1 seul fichier est sélectionnable à la fois)
fd.AllowMultiSelect = False
' Texte du bouton
fd.ButtonName = "Sélectionner"
' Nom du fichier de départ
fd.InitialFileName = "monfichier.xls"
' Type de vue au départ
fd.InitialView = msoFileDialogViewLargeIcons
' Afficher la boîte de dialogue
If fd.Show() Then
' MsgBox "Vous avez sélectionné le fichier : " _
' & vbCrLf & fd.SelectedItems(1), vbInformation
Fichier = fd.SelectedItems(1)
Set Cn = New ADODB.Connection
Set oCat = New ADOX.Catalog
Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Fichier & _
";Extended Properties=Excel 8.0;"
Set oCat.ActiveConnection = Cn
On Error Resume Next
'Vérifie si la feuille "Feuil1" existe dans le classeur fermé
Set Feuille = oCat.Tables("Feuil1$")
'ici calcul le nombre de ligne
nblig = sheet.Range("C65536").End(xlUp).Row
On Error GoTo 0
If Feuille Is Nothing Then
MsgBox "Dans le classeur - monfichier.xls - la (Feuil1) n'existe pas..."
Else
'essai du nombre de ligne
MsgBox nblig
'-----------------------------------------------------------------------------
Set oApp = CreateObject("excel.application")
Set oWkb = oApp.Workbooks.Open(fd.SelectedItems(1))
Set oWSht = oWkb.Worksheets("Feuil1")
'premier ligne ou tu commence ton import
I = 2
'pour éviter les messages lors de l'ajout des enregistrements
DoCmd.SetWarnings False
'tant que la cellule n'est pas vide
While oWSht.Range("C" & I).Value <> ""
cSQL = "insert into [ICI ma table] ( [colonne1], [colonne2], [colonne3], [colonne4], [colonne5], [colonne6] ) values (" & Chr(34) & oWSht.cells(I, 1) & Chr(34) & ", " & Chr(34) & oWSht.cells(I, 2) & Chr(34) & ", " & Chr(34) & oWSht.cells(I, 3) & Chr(34) & ", " & Chr(34) & oWSht.cells(I, 4) & Chr(34) & ", " & Chr(34) & oWSht.cells(I, 5) & Chr(34) & ", " & Chr(34) & oWSht.cells(I, 6) & Chr(34) & ")"
'exécute la requète
DoCmd.RunSQL cSQL
I = I + 1
Wend
DoCmd.SetWarnings True
'-----------------------------------------------------------------------------
End If
Set fd = Nothing
End If
Set Feuille = Nothing
Set oCat = Nothing
Cn.Close
Set Cn = Nothing |
Partager