Export Feuille Excel vers Access

Salut,
Essai ceci en exécutant la proc "AjoutDansTable". Il te faut adapter le nom
et le chemin de ta base dans la proc "ConnecterBase" et le nom de la feuille
dans la proc "AjoutDansTable" où sont réccupérées les valeurs :

Private Sub ConnecterBase(ConnectBD As Object, _
Optional Rs)

Set ConnectBD = CreateObject("ADODB.Connection")
If Not IsMissing(Rs) Then
Set Rs = CreateObject("ADODB.Recordset")
End If

With ConnectBD
.Provider = "Microsoft.Jet.OLEDB.4.0"
'ici adapter le chemin et nom de la base
.ConnectionString = "D:BaseTest.mdb"
.Open
End With

End Sub

Private Sub AjoutDansTable()
Dim ConnectBD As Object
Dim Rs As Object
Dim Cl As Workbook
Dim Fe As Worksheet
Dim I As Integer
Dim Fichier As String

Fichier = Application.GetOpenFilename("Fichiers Excel (*.xls), *.xls", , _
"Sélectionnez un fichier !")

If Fichier <> "" Then
Set Cl = Application.Workbooks.Open(Fichier)
Else
Exit Sub
End If

'adapter le nom de la feuille
Set Fe = Cl.Worksheets("Feuil1")

'connexion
ConnecterBase ConnectBD, Rs

With Rs
.CursorType = 1
.LockType = 3
'adapter le nom de la table, "Table1"
.Open "SELECT * FROM Table1", ConnectBD
'ajout de plusieurs enregistrements
'situés à partie de la ligne 2 afin d'éviter
'les entêtes de colonnes. A adapter sinon
For I = 2 To [A65536].End(xlUp).Row
.AddNew
.Fields("Nom") = Fe.Cells(I, 1)
.Fields("Prenom") = Fe.Cells(I, 2)
.Fields("Age") = Fe.Cells(I, 3)
.Fields("Ville") = Fe.Cells(I, 4)
.Update
Next I
End With

ConnectBD.Close

Set Fe = Nothing
Set Cl = Nothing
Set Rs = Nothing
Set ConnectBD = Nothing
End Sub

Hervé.


"pedro" <anonymous@discussions.microsoft.com> a écrit dans le message de
news: 2c2301c470af$483447b0$a301280a@phx.gbl...
Bonjour,

Je veux exporter les données contenues dans un classeur
Excel fermé vers une table Access.

J'ai trouvé deux codes sources et mon problème est de ne
pas savoir lier les deux codes sources , ce qui me
permettra d'exporter les données de la feuille (que je
fixer par défaut) du classeur du fichier qui serait
sélectionné: c

1- Le premier me permet à tavers une boîte de dialog
choisir le fichier:
Sub macro1()
FileFilter ="Excel Files (*.XLS),"*.XLS"
Caption = "Please Select a file" & the User
SelectedFile= Application.GetOpenFilename(FileFilter, ,
Caption)
...

2- Le deuxième me permet de transferer les données de la
feuille active d'un fichier déjà ouvert:

Sub synthese()
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As
Long
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=C:Test.mdb;"
Set rs = New ADODB.Recordset
rs.Open "Table1", cn, adOpenKeyset, adLockOptimistic,
adCmdTable
r = 2
Do While Len(Range("A" & r).Formula) > 0
With rs
.AddNew
.Fields("Nom") = Range("A" & r).Value
.Fields("Prenom") = Range("B" & r).Value
.Fields("Age") = Range("C" & r).Value
.Fields("Ville") = Range("D" & r).Value

.Update
End With
r = r + 1
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub



Merci pour votre aide