Voilà ce que j'ai fait.

Il faut créer un module et tu le nommes, par exemple : ModBdd et tu colles le codes ci dessous

'
' Module générique d'une connexion
' à une base de données Access
'
' Renseigner la constante privée myPathBd
' Renseigner la constante privée mybd (nom de la base)
'
'@ Author : Polux31 - 2007
'

Option Explicit

Dim cnnADO As New ADODB.Connection ' Pour la connection à la base de données
Dim cmdAdo As New ADODB.Command ' Pour la commande à la base de données
Dim RScnx As New ADODB.Recordset ' Pour recevoir le résultat de la commande
Dim NbEnr As Integer ' Pour recevoir le nombre d'enregistrement du recordset
Dim Connect As String ' pour recevoir le nom de la connection

Private Const myPathBd = "c:\MonRepertoireTest\" ' Chemin d'accès au répertoire la base de données
Private Const mybd = "bd\mabaseTest.mdb" ' nom du dossier et de la base

Public Function getConnect() As String
getConnect = Connect
End Function

Public Sub setNbEnr(ByVal str As Integer)
NbEnr = str
End Sub

Public Function getNbEnr() As Integer
getNbEnr = NbEnr
End Function

Public Function InitBdd() ' ouverture de la base donnée
Dim CnxStrg As String ' Variable qui reçois la chaine de connection

If cnnADO.State = adStateOpen Then
cnnADO.Close
End If

CnxStrg = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & myPathBd & mybd

cnnADO.ConnectionString = CnxStrg
cnnADO.CursorLocation = adUseClient

On Error Resume Next
cnnADO.Open

If Err <> 0 Then
' MsgBox "Erreur de connection : [" & CnxStrg & "]"
Connect = "Erreur de connection : \\" & mybd
Exit Function
Else
Connect = "Connection à la base : \\" & mybd
End If

End Function

' Fonction générique pour le passage d'une requête à la base de données, reçois la requete et le recordset, retourne un booléen
Public Function OpenRecordset(ByVal requete As String, ByRef RS As ADODB.Recordset) As Boolean

Call setNbEnr(0) 'initialise le nb d'enregistrement
If RS.State = adStateOpen Then ' test le statut de la base
RS.Close
End If

On Error Resume Next
RS.Open requete, ModBdd.cnnADO, , , adCmdText 'Envoi du recordset
Call setNbEnr(RS.RecordCount) ' Nombre de record

If Err.Number <> 0 Then
OuvrirRecordset = False 'La transaction n'est pas réalisée, retourne False
Exit Function
End If

RS.MoveFirst ' Positionnement sur le premier enregistrement du RecordSet
OuvrirRecordset = True ' La transaction a été réalisée, retourne True

End Function

'Fonction qui déplace le curseur vers l'enregistrement précédent
Public Function RSLirePrecedent(ByRef RS As ADODB.Recordset) As Boolean

On Error Resume Next
RS.MovePrevious 'l'occurence précédente
If RS.BOF Then 'vérifie si l'on est pas déjà sur le premier enregistrement
RSLirePrecedent = False
Exit Function 'si on est sur le premier on sort de la fonction
End If

If Err <> 0 Then
RSLirePrecedent = False
Exit Function
End If

RSLirePrecedent = True

End Function

'Fonction qui déplace le curseur vers l'enregistrement suivant
Public Function RSLireSuivant(ByRef RS As ADODB.Recordset) As Boolean

On Error Resume Next
RS.MoveNext 'l'occurence suivante
If RS.EOF Then 'vérifie si l'on est pas déjà sur le dernier enregistrement
RSLireSuivant = False
Exit Function 'si oui on sort
End If

If Err <> 0 Then
RSLireSuivant = False
Exit Function
End If

RSLireSuivant = True

End Function

'Fonction qui déplace le curseur sur le premier enregistrement
Public Function RSLirePremier(ByRef RS As ADODB.Recordset) As Boolean

On Error Resume Next
RS.MoveFirst 'première occurence
If Err <> 0 Then
RSLirePremier = False
Exit Function
End If

RSLirePremier = True

End Function

'Fonction qui déplace le curseur sur le dernier enregistrement
Public Function RSLireDernier(ByRef RS As ADODB.Recordset) As Boolean

On Error Resume Next
RS.MoveLast 'dernière occurence
If Err <> 0 Then
RSLireDernier = False
Exit Function
End If

RSLireDernier = True

End Function

'====\\========

Ensuite pour pouvoir utiliser ces fonctions depuis un formulaire ou d'un module:

Public Sub OuvrirRequete()
Dim vrai As Boolean
Dim Query As String
Dim Rs As ADOBC.RecordSet
Dim echange As String
Dim strNum As Variant
Dim strSSres As Variant

With FrmTest
echange = .O1.Value & "." & .O2.Value & "." & (Int(.O3.Value / 4) * 4) & "." & "0"
End With

On Error Resume Next
Query = "SELECT Num, SSres FROM T_Sous_réseaux COMETE WHERE SSres =' " & echange & " ' "
Set Rs = New ADODB.RecordSet

vrai = ModBdd.OpenRecordset(Query, Rs)
If vrai = False then
MsgBox "Erreur: la requête [" & Query & "] n'a pas abouti",,"Message Application"
Exit Sub
Else
strNum = Rs.Fields(0).value
strSSres = Rs.Fields(1).value
MsgBox strNum & " et " & strSSres
End If

End Sub
==//====

J'ai testé ça rapidement avec VB6 et une base Access, ça marche.

Bon courage

:o)

Bonjour


Voila mon soucis :

G une base Access créer sous 97 et je dois l utiliser avec VBA 6.3

Je voudrais savoir comment faire la connection a la base de données car mon fichier plante :

Voila mon code :

Sub COdispatcher()

Dim colCOd As Integer 'N° de la colonne pour la feuille COdispatcher
Dim ligdmh As Integer 'N° de la colonne pour la feuille FamilleCO
Dim i As Integer
Dim a As String

colCOd = 3
While (Not (IsEmpty(Worksheets("COdispatcher").Cells(8, colCOd))))
'Entrée des heures + Msg si la famille existe pas
i = 8
While (Not (IsEmpty(Worksheets("COdispatcher").Cells(i, colCOd))))
Worksheets("COdispatcher").Cells(i, colCOd + 1).ClearContents
ligdmh = 7
While (Not (IsEmpty(Worksheets("familleRequete").Cells(ligdmh, 3))) And Worksheets("familleRequete").Cells(ligdmh, 3) <> Worksheets("COdispatcher").Cells(i, colCOd))
ligdmh = ligdmh + 1
Wend
If (Not (IsEmpty(Worksheets("familleRequete").Cells(ligdmh, 3)))) Then
Worksheets("COdispatcher").Cells(i, colCOd + 1) = Worksheets("familleRequete").Cells(ligdmh, 4)
Else
MsgBox ("ATTENTION La famille " & Worksheets("COdispatcher").Cells(i, colCOd) & " n'existe pas")
End If
i = i + 1
Wend

'Requete pour le CO

a = "select sum(" & Range("Parametre!E11") & ") from " & Range("Parametre!D7") & " where " & Range("Parametre!D11") & " like '" & Worksheets("COdispatcher").Cells(7, colCOd) & "';"

Sheets("COdispatcher").Select

With ActiveSheet.QueryTables.Add(Connection:= _
"ODBC;DSN=MS Access 97 Database;DBQ=" & Range("Parametre!D6") & ";DefaultDir="chemin";DriverId=281;FIL", _
Destination:=Worksheets("COdispatcher").Cells(7, colCOd + 2), Sql:=a) 'emplacement du resultat

.Sql = a
.FieldNames = False 'Nom des champs de la BD
.RefreshStyle = xldeleteEntireRows ' Pour l insertion des nouvelles données
.RowNumbers = False
.FillAdjacentFormulas = False
.RefreshOnFileOpen = False
.HasAutoFormat = False 'surement a laisser
.BackgroundQuery = True
.TablesOnlyFromHTML = True
.Refresh BackgroundQuery:=False
.SavePassword = True
.SaveData = True
End With

'Calcul de la somme
Worksheets("COdispatcher").Cells(7, colCOd + 1) = "=SUM(R[1]C:R[65000]C)"

'Calcul des Heures / Famille
i = 8
While (Not (IsEmpty(Worksheets("COdispatcher").Cells(i, colCOd))))
Worksheets("Codispatcher").Cells(i, colCOd + 2) = "=R[-" & i - 8 + 1 & "]C* RC[-1]/R[-" & i - 8 + 1 & "]C[-1]"
i = i + 1
Wend
colCOd = colCOd + 3
Wend
End Sub




Est ce que l appel de la connection a la base de données se fait de cette façon???
j en peu plus ca fait une semaine que je cherche!!!!!

Merci pour tout