[VBA] connexion Access à une base SQL server

Question

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

zavier666 · Answer

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

cs_tsunam · Answer

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

zavier666 · Answer

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

dofrancis3 · Answer

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

[VBA] connexion Access à une base SQL server

4 réponses

Votre réponse

Discussions similaires