[VBA] connexion Access à une base SQL server

Messages postés
3
Date d'inscription
vendredi 5 septembre 2008
Statut
Membre
Dernière intervention
18 mars 2009
- - Dernière réponse : dofrancis3
Messages postés
2
Date d'inscription
lundi 22 août 2011
Statut
Membre
Dernière intervention
18 juillet 2013
- 18 juil. 2013 à 08:46
Bonjour à tous,

J'ai réussi à lier des tables de SQL server express 2008 vers Access 2003.
(fichier, données externes, lier les tables... Pilote fonctionnel et tables visibles... Mais j'ai dû les effacer...)

Mais mon tuteur ne veut pas qu'on lie directement les tables, mais qu'on le fasse par du code...
Pour Access, il n'aurait aucune table de reconnu, mais par des fonctions de connexions et de déconnexion, ilm arriverait à les atteindre.
ça me parait plausible, mais je n'arrive pas à trouver des fonctions de connexion et déconnexion, mais surtout, je ne vois pas comment lister des éléments de mes tables dans les éléments de mon formulaire...
Bref j'ai vraiment de mal et je viens de faire 2 jours de recherche infructueuses...
Toute aide serait la bienvenue...


Tof
Afficher la suite 

4 réponses

Messages postés
267
Date d'inscription
mardi 7 septembre 2004
Statut
Membre
Dernière intervention
30 avril 2009
0
Merci
Avec access, tu dois pouvoir extraire la chaine de connexion qui a été utilisée lors de la création de tes liaisons: déjà tu disposeras de la chaine de connexion.

il faut que tu utilises les classes style ODBC ou OLEDB pour créer un objet qui te permettra
=> d'établir une xonnexion à un serveur
=> d'en lister les bases de données
=> dpour chaque base d'en lister les tables
=> pour chaque table, d'en lister les colonnes
=> et de faire toutes les requete select/insert / update que tu veux

j'ai fait une source (en .Net) mais qui peut s'adapter (avec un peu de boulot) à ton problème

--------------------------------------------------
Toujours + de VB et d'API => APi @ le Loupe
Commenter la réponse de zavier666
Messages postés
3
Date d'inscription
vendredi 5 septembre 2008
Statut
Membre
Dernière intervention
18 mars 2009
0
Merci
J'ai commencé un petit bout de code...
J'ai déjà fait des classes de connexion, déconnexion et exécution en VB.NET mais mon code ne s'adapte pas...
J'ai un peu avancé, voici un peu de code :

Dim str_chaine As String
Dim cnADO As New ADODB.CONNECTION
Dim NomServeur As String
Dim NomBaseDeDonnées As String
NomServeur = "ECK"
NomBaseDeDonnées = "D:\Mes Documents\Site\App_Data\Database.mdf"
Set cnADO = New ADODB.CONNECTION

'Définition de la chaîne de connexion
str_chaine = "DRIVER={SQL Server Native Client 10.0};Server=" & NomServeur & ";Database=" & NomBaseDeDonnées & ";"

cnADO.Open str_chaine

MsgBox (cnADO.State)

ECK est le nom de mon pilote que j'ai créé (machine...) il est fonctionnel car en l'utilisant par liaison des tables, j'arrive à voir mes tables.
Seulement, j'ai un message d'erreur dans ce petit bout de code qui teste ma connexion :

Erreur d'execution '-2147467259 (80004005)':
[Microsoft][SQL Server Native Client 10.0]Fournisseur de canaux nommés : Impossible d'ouvrir une connexion à SQL Server [53]

Alors que le pilote devrait être fonctionnel...
Je cherche juste à afficher l'état de ma connexion.
Si T'as une idée...
Merci

Tof
Commenter la réponse de cs_tsunam
Messages postés
267
Date d'inscription
mardi 7 septembre 2004
Statut
Membre
Dernière intervention
30 avril 2009
0
Merci
as-tu bien configuré la surface d'exposition de sql serveur dans le logiciel de configuration

--------------------------------------------------
Toujours + de VB et d'API => APi @ le Loupe
Commenter la réponse de zavier666
Messages postés
2
Date d'inscription
lundi 22 août 2011
Statut
Membre
Dernière intervention
18 juillet 2013
0
Merci
Bonjour mon cher juste pour te demander une aide car j'ai trouver ton adresse mail dans un forum et et tu avis presque la même difficulté que j'ai bien qu'ait certaine divergence.
en faite j'ai réalisé une base de données en Access et Sql Server mais je me suis rendu compte qu'il faut utiliser la bibliothèque ADO mes code en que tu trouvera en attache fonctionnent bien avec Access mais quant j'utilise même code avec ma base sql ça ne marche pas. SVP veuillez corriger mon code en attache pour l'adapter avec ADO (ou Sql Server) j'attends ta réponse SVP dés que tu reçois ce message merci d'avance.
N.B: le code me donne des erreur que j'ai mis en jaune.

Option Compare Database
Option Explicit
' Variables à modifier
Dim expressionET(1 To 4) ' A dimensionner selon le nombre maximum de critères
Dim expressionOU(1 To 4) ' A dimensionner selon le nombre maximum de critères
Const vSource = "Liste_MontantTotal_des_Contrats" ' Nom de la table ou requête source du formulaire de recherche
Private Sub Btn_RAZ_Click()
CurrentDb.QueryDefs("filtre").SQL = "SELECT * FROM " & vSource & " WHERE false"
Me![SF_FiltreMTC].Form.RecordSource = "filtre"
'Me.Lbl_SQL.Caption = ""
Me.ListeDesChamps1 = Null
Me.ListeDesChamps2 = Null
Me.ListeDesChamps3 = Null
Me.ListeDesChamps4 = Null
Me.CritèreDuChamp1 = Null
Me.CritèreDuChamp2 = Null
Me.CritèreDuChamp3 = Null
Me.CritèreDuChamp4 = Null
Me.CritèreOUChamp1 = Null
Me.CritèreOUChamp2 = Null
Me.CritèreOUChamp3 = Null
Me.CritèreOUChamp4 = Null
End Sub





Private Sub ExécuteLaRecherche_Click()
Dim MonSQL As String, MonCritère As String
Dim Marequête As DAO.QueryDef
Dim TypeChamp
Dim I
Dim nbExpressionET, nbExpressionOU
On Error Resume Next
'Me.Lbl_SQL.Caption = ""
'Lire les critères "ET"
I = 1
Do While Len(Me("CritèreDuChamp" & I)) > 0
expressionET(I) = "(" &BuildCriteria(Me("ListeDesChamps" & I).Column(1), _
Me("ListeDesChamps" & I).Column(2), Nz(Me("CritèreDuChamp" & I), "null")) & ")"
I = I + 1
Loop
nbExpressionET = I - 1
'Lire les critères "OU"
I = 1
Do While Len(Me("CritèreOUChamp" & I)) > 0
expressionOU(I) = "(" &BuildCriteria(Me("ListeDesChamps" & I).Column(1), _
Me("ListeDesChamps" & I).Column(2), Nz(Me("CritèreOUChamp" & I), "null")) & ")"
I = I + 1
Loop
nbExpressionOU = I - 1
' Efface la requête par mesure de sécurité, afin de ne pas supprimer une ancienne recherche
CurrentDb.QueryDefs("filtre").SQL = "SELECT * FROM " &vSource& " WHERE false"
' Initialisel'instruction SELECT
MonSQL = "SELECT * FROM " &vSource&" WHERE "
If nbExpressionET 0 Then MonSQL Left(MonSQL, Len(MonSQL) - 6)
Select Case nbExpressionET
Case 1
MonSQL = MonSQL&expressionET(1)
Case Is > 1
MonSQL = MonSQL& "("
For I = 1 TonbExpressionET
MonSQL = MonSQL&expressionET(I) & " AND "
Next
MonSQL = Left(MonSQL, Len(MonSQL) - 5) ' Enlever le dernier " AND "
MonSQL = MonSQL& ")"
End Select
Select Case nbExpressionOU
Case 1
MonSQL = MonSQL& " OR (" &expressionOU(1) & ")"
Case Is > 1
MonSQL = MonSQL& " OR (" &expressionOU(1) & " AND "
For I = 2 TonbExpressionOU
MonSQL = MonSQL&expressionOU(I) & " And "
Next
MonSQL = Left(MonSQL, Len(MonSQL) - 5) ' Enlever le dernier " AND "
MonSQL = MonSQL& ")"
End Select
' Défini la propriété RecordSource du filtre.
If IsNull(Me.ListeDesChamps1) = 0 Then
MonSQL = MonSQL&" ORDER BY " & Me.ListeDesChamps1.Column(1)
Else
End If
CurrentDb.QueryDefs("Filtre").SQL = MonSQL
Me![SF_FiltreMTC].Form.RecordSource = Filtre
' Si aucun enregistrement ne correspond aux critères, affiche un message.
' Active le bouton Effacer.
If Me![SF_FiltreMTC].Form.RecordsetClone.RecordCount = 0 Then
MsgBox "Aucun enregistrement trouvé", 48, "Recherche"
'Me!Effacer.SetFocus
End If
End Sub
Private Sub cmd_Export_Click()
Dim xlApp As Excel.Application
Dim xlSheet As Excel.Worksheet
Dim xlBook As Excel.Workbook
Dim I As Long, J As Long
Dim t0 As Long, t1 As Long
t0 = Timer
Dim rec As Recordset
Set rec = CurrentDb.OpenRecordset("Filtre", dbOpenSnapshot)
'Initialisations
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
'Ajouter une feuille de calcul
Set xlSheet = xlBook.Worksheets.Add
xlSheet.Name = "Tutoriel"
' le titre
' écriture dans la cellule de ligne 1 et de colonne 1
xlSheet.Cells(1, 1) = "Export d'une table Access"
' lesentetes
' .Fields(Index).Name renvoie le nom du champ
For J = 0 Torec.Fields.Count - 1
xlSheet.Cells(2, J + 1) = rec.Fields(J).Name
' Nous appliquons des enrichissements de format aux cellules
With xlSheet.Cells(2, J + 1)
.Interior.ColorIndex = 15
.Interior.Pattern = xlSolid
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeBottom).ColorIndex = xlAutomatic
.HorizontalAlignment = xlCenter
End With
Next J
' recopie des données à partir de la ligne 3
I = 3
Do While Not rec.EOF
For J = 0 Torec.Fields.Count - 1
' .Fields(Index).Type renvoie le type du champ
' si c'est un Texte (dbText) nous insérons "'" pour
' qu'il soit reconnu par Excel comme du Texte
If rec.Fields(J).Type = dbText Then
xlSheet.Cells(I, J + 1) = "'" &rec.Fields(J)
Else '-----> j'ai un message d'erreur (erreur 1004 = erreur defini par l'application ou par l'objet)
xlSheet.Cells(I, J + 1) = rec.Fields(J) '-----> et pr afficher la date je dois mettre dbdate
End If
Next J
I = I + 1
rec.MoveNext
Loop
' code de fermeture et libération des objets
xlBook.SaveAs "C:\Users\francisD\Documents\Feuille.xlsx"
xlApp.Quit
rec.Close
Set rec = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
t1 = Timer
Debug.Print I &" enregistrements", Format(t1 - t0, "0") & " secondes"
'Debug.Print (SQL)
End Sub
3) Private Sub Form_Open(Cancel As Integer)
On Error GoTo Error_FormOpen
Dim test As String
'Tester si la requête "Filtre" existe; sinon renvoie l'erreur 2489
test = CurrentDb.QueryDefs("Filtre").SQL
' Efface la requête par mesure de sécurité, afin de ne pas afficher une ancienne recherche
CurrentDb.QueryDefs("filtre").SQL = "SELECT * FROM " & vSource & " WHERE false"
Me![SF_Filtre].Form.RecordSource = "filtre"
Exit Sub
Error_FormOpen:
Select Case Err
Case 3265 ' la requête filtre n'existe pas,alors on va la créer
CurrentDb.CreateQueryDef "filtre", "SELECT * FROM " & vSource & " WHERE false"
Resume Next
Case Else
MsgBox Err.Description
Exit Sub
End Select
End Su
Commenter la réponse de dofrancis3