
| auteur : SilkyRoad |
Cette procédure Excel permet de créer une nouvelle table dans une base Access existante et d'y transférer
le contenu d'un fichier csv.
La macro nécessite d'activer la référence "Microsoft ActiveX Data Objects x.x Library".
Vba |
Sub tranfertCSV_Vers_NouvelleTableAccess ()
Dim AccessCn As ADODB. Connection
Dim AccessRst As ADODB. Recordset
Dim Csv_CN As New ADODB. Connection
Dim Csv_Rst As New ADODB. Recordset
Dim DossierCSV As String , NomTable As String
Dim FichCSV As String , MaBase As String
Dim nbEnr As Long
DossierCSV = " C:\Documents and Settings\mimi\dossier "
FichCSV = " LeFichierCSV.csv "
MaBase = " C:\Documents and Settings\mimi\dossier\dataBase.mdb "
NomTable = " MaNouvelleTable "
Csv_CN. Open " Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & _
DossierCSV & " ;Extended Properties='text;FMT=Delimited' "
Csv_Rst. Open " SELECT * FROM " & FichCSV, Csv_CN, _
adOpenStatic , adLockOptimistic
Set AccessCn = New ADODB. Connection
AccessCn. Open " Provider=Microsoft.Jet.OLEDB.4.0; " & _
" Data Source= " & MaBase
Csv_CN. Execute " SELECT * INTO [ " & NomTable & " ] IN ' " & _
MaBase & " ' From [ " & FichCSV & " ] " , nbEnr
AccessCn. Close
Csv_Rst. Close
Csv_CN. Close
Set AccessRst = Nothing
Set AccessCn = Nothing
Set Csv_Rst = Nothing
Set Csv_CN = Nothing
End Sub
|
|
| auteur : SilkyRoad |
Excel dispose d'un outil intégré pour effectuer des requêtes dans des sources de données externes.
Sans macro, vous pouvez utiliser le menu Données / Données externes / Créer une requête.
Suivez les différentes étapes et complétez les boîtes de dialogue afin de paramétrer l'extraction.
Le même résultat peut être obtenu par macro:
Cette procédure effectue une requête dans une table Access et affiche le résultat dans la cellule A1.
Vba |
Dim NomBase As String
NomBase = " C:\Documents and Settings\mimi\dataBase.mdb "
With Sheets (" Feuil1 " ). QueryTables . Add (Connection:= Array (" OLEDB;Provider=Microsoft.jet.OLEDB.4.0; " & _
" Data source= " & NomBase), Destination:= Sheets (" Feuil1 " ). Range (" A1 " ))
. CommandText = Array (" SELECT * FROM Table1 WHERE CodeClient=42000 " )
. Name = " TestRequete "
. CommandType = xlCmdTable
. FieldNames = False
. RowNumbers = False
. PreserveFormatting = False
. BackgroundQuery = True
. RefreshStyle = xlOverwriteCells
. AdjustColumnWidth = True
. PreserveColumnInfo = False
. Refresh BackgroundQuery:= False
End With
|
Faites vous aider par l'enregistreur de macro si vous ne connaissez pas la syntaxe à utiliser.
|
| auteur : SilkyRoad | Vba |
Sub VersionMDAC ()
Dim Cn As Object
Set Cn = CreateObject (" ADODB.Connection " )
MsgBox " Version MDAC : " & Cn. Version
Set Cn = Nothing
End Sub
|
|
| auteur : SilkyRoad | Vba |
Sub creationNouvelleBase ()
Dim Cat As ADOX. Catalog
Dim MaTableIndex As ADOX. Table
Dim CheminBase As String , NomTable As String
CheminBase = " C:\MaNouvelleBase.mdb "
NomTable = " MaTable "
Set Cat = New ADOX. Catalog
Cat. Create " Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & CheminBase
Set MaTableIndex = CreateObject (" ADOX.Table " )
With MaTableIndex
. Name = NomTable
With . Columns
. Append " ChampDate " , adDate , 50
. Append " ChampNombre " , adInteger , 50
. Append " ChampTexte " , adWChar , 80
End With
End With
Cat. Tables . Append MaTableIndex
Set Cat = Nothing
Set MaTableIndex = Nothing
End Sub
|
|
| auteur : SilkyRoad |
Ce premier exemple utilise le modèle ADO:
Vba |
Sub AjoutEnregistrementTableAccess ()
Dim Cn As ADODB. Connection
Dim Fichier As String , TexteSQL As String
Fichier = " C:\NomBase.mdb "
Set Cn = New ADODB. Connection
Cn. Open " DRIVER={Microsoft Access Driver (*.mdb)}; DBQ= " & Fichier
TexteSQL = " INSERT INTO [Table1] VALUES (# " & _
Date & " #, " & 12345 & " , ' " & Environ (" username " ) & " ') "
Cn. Execute TexteSQL
Cn. Close
Set Cn = Nothing
End Sub
|
Il est aussi possible d'utiliser la bibliothèque DAO.
Ci-joint un exemple qui ajoute un enregistrement de 6 champs dans une table Access.
Vous remarquerez que toutes les données sont encadrées par des apostrophes, quelque soit
le type de champ.
Vba |
Sub exportDonnées_DAO ()
Dim Db As DAO. Database
Dim strSQL As String
Set Db = DAO. OpenDatabase (" C:\dossier\dataBase.mdb " , False , False )
strSQL = " INSERT INTO [Table1] VALUES('999','8','DVP','7','mimi','22/10/2007') "
Db. Execute strSQL
Db. Close
End Sub
|
|
| auteur : SilkyRoad |
Cet exemple utilise la bibliothèque DAO.
Vba |
Sub importDonnees_DAO ()
Dim Db As DAO. Database
Dim Rs As DAO. Recordset
Dim strSQL As String
Set Db = DAO. OpenDatabase (" C:\dossier\dataBase.mdb " , False , False )
strSQL = " SELECT * FROM [Table1] "
Set Rs = Db. OpenRecordset (strSQL, DAO. dbOpenSnapshot )
Range (" A1 " ). CopyFromRecordset Rs
Db. Close
End Sub
|
|
lien : Communication entre Access et Excel
|
| auteur : SilkyRoad |
Ce code effectue un tri croissant dans la colonne "NomChamp" de la table "LesPoints".
Vba |
Sub Tri_Croissant_Champ_BaseAccess ()
Dim Cnn As ADODB. Connection
Dim Cat As ADOX. Catalog
Dim indexTri As ADOX. Index
Dim Rst As New ADODB. Recordset
Dim Fichier As String
On Error GoTo Fin
Fichier = " C:\dossier\dataBase.mdb "
Set Cnn = New ADODB. Connection
Cnn. Open " Provider='Microsoft.Jet.OLEDB.4.0'; " & _
" Data Source=' " & Fichier & " '; "
Set Cat = New ADOX. Catalog
Set Cat. ActiveConnection = Cnn
Set indexTri = New ADOX. Index
With indexTri
. Columns . Append " NomChamp "
. Columns (" NomChamp " ). SortOrder = adSortAscending
. Name = " Cible "
End With
Cat. Tables (" LesPoints " ). Indexes . Append indexTri
Fin :
Cnn. Close
Set Cat = Nothing
Set indexTri = Nothing
Set Rst = Nothing
Set Cnn = Nothing
End Sub
|
|
| auteur : SilkyRoad |
Une première solution:
Vba |
Sub listerConnectesBaseAccess_V01 ()
Dim Cible As String
Dim strLigne As String
Cible = " C:\Documents and Settings\dossier\dataBase.ldb "
If Dir (Cible) = " " Then Exit Sub
Open Cible For Input As #1
Do While Not EOF (1 )
Line Input #1 , strLigne
Debug. Print strLigne
Loop
Close #1
End Sub
|
Une deuxième solution:
Vba |
Sub listerConnectesBaseAccess_V02 ()
Dim Cnn As Object
Dim Rst As Object
Dim Fichier As String
Const JET_SCHEMA_USERROSTER = " {947bb102-5d43-11d1-bdbf-00c04fb92675} "
Fichier = " C:\Documents and Settings\dossier\dataBase.mdb "
If Dir (Fichier) = " " Then Exit Sub
Set Cnn = CreateObject (" ADODB.Connection " )
Cnn. Open " Provider=Microsoft.Jet.OLEDB.4.0; " & _
" Data Source= " & Fichier & " ; "
Set Rst = CreateObject (" ADODB.Recordset " )
Set Rst = Cnn. OpenSchema (- 1 , , JET_SCHEMA_USERROSTER)
Debug. Print Rst. GetString
Cnn. Close
Set Rst = Nothing
Set Cnn = Nothing
End Sub
|
|
| auteur : SilkyRoad |
La procédure crée un nouveau classeur contenant une feuille nommée "NomFeuille". La requête effectuée
dans la table Access va être enregistrée dans cette feuille.
Nécessite d'activer la référence "Microsoft ActiveX Data Objects x.x Library".
Vba |
Sub Test ()
TransfertAccess_Vers_Excel " C:\SauvegardeClasseur.xls " , " NomFeuille "
End Sub
Sub TransfertAccess_Vers_Excel (NomClasseur As String , maFeuille As String )
Dim AccessCnn As ADODB. Connection
Dim maBase As String , maTable As String
Dim nbEnr As Long
maBase = " C:\Documents and Settings\dossier\database.mdb "
maTable = " Table1 "
Set AccessCn = New ADODB. Connection
AccessCnn. Open " provider=microsoft.jet.oledb.4.0; data source= " & maBase
AccessCnn. Execute " SELECT * INTO [Excel 8.0; " & _
" Database= " & NomClasseur & " ].[ " & maFeuille & " ] FROM " & maTable, nbEnr
AccessCnn. Close
Set AccessCnn = Nothing
End Sub
|
Et si vous désirez effectuer la même opération directement depuis Access:
Vba |
Sub TransfertAccess_Vers_Excel ()
Dim NomClasseur As String , maFeuille As String
Dim maTable As String
Dim nbEnr As Long
NomClasseur = " C:\SauvegardeClasseur.xls "
maFeuille = " NomFeuille "
maTable = " Table1 "
CurrentDb. Execute " SELECT * INTO [Excel 8.0; " & _
" Database= " & NomClasseur & " ].[ " & maFeuille & " ] FROM " & maTable, nbEnr
CurrentDb. Close
End Sub
|
|
Consultez les autres F.A.Q's
Les sources présentés sur cette pages sont libre de droits,
et vous pouvez les utiliser à votre convenance. Par contre cette page de présentation de ces sources constitue une oeuvre intellectuelle protégée par les droits d'auteurs.
Copyright ©2008
Developpez LLC. Tout droits réservés Developpez LLC.
Aucune reproduction, même partielle, ne peut être faite de ce site et de
l'ensemble de son contenu : textes, documents et images sans l'autorisation
expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à 3 ans
de prison et jusqu'à 300 000 E de dommages et intérets.
Cette page est déposée à la SACD.
|