Access et VB

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)

Ca a rien fait de neuf, il bloque toujours plus bas :/ Question bête; pourquoi je peux pas afficher le contenu de rs dans une msgBox ?
(je précise, je n'y connais absolument rien en VB)

Do Until Not rs.EOF
strNum = rs("Num").Value <----------- Cha bloque ici
strSSres = rs("SSres").Value
MsgBox strNum & " et "
rs.MoveNext
Loop

Comme je n'y connais rien en VB, je n'ai aucun contrôle ou idée de comment faire, ca m'enerve :@ Ca me parait un poilcompliqué en plus :/

Je suis peut être parti dans la mauvaise direction, je vais exprimer mon besoin:

J'ai un formulaire dans lequel les users mettent leur adresse IP, et duquel après un tour de passe-passe, me sors le sous réseau afférent dans une variable (echange). Apartir de cette donnée, je voudrais faire une requete sur une table contenant une liste de sous-réseaux afin de sortir celui qui correspond, et sortir ce résultat dans un bo formulaire ( ca je sais faire)

En gros ce qui me bloque actuellement c'est la requête a faire depuis la variable et de ressortir ca dans un formulaire.

J'espère avoir été plus clair^^

Ma base est en local, sur le poste sur lequel je suis actuellement. Après pour les référence de drivers j'ai bien mis ADO et DAO (les deux dans le doute lol). Mon but final est d'en faire un outil distribuable dans mon service :)

miciiiiiiiii :)

Ca bloque dès le début en surlignant ca : Dim Rs As ADOBC.Recordset et en disant "type défini par l'utilisateur non défini" :'(:'(:'(

Et quelle est la différence entre les deux constante du début, je pige pas, sachant que la base est sur mon disque dans un dossier :/

b soir
j vex voir commnt fait la rlation entre le vb 6 et un base d donnée

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

Bonjour je me permet de m'immisser :D

Je suis actuellement en train de travailler sur la sécurisation de bases de données Access, plus pécisement sur une gestion des utilisateurs, et ce via Visual Basic.

J'ai créé 5 tables (forms "name & ID" + users "name & ID" + profiles "name & ID" + tbl_User_Profile_Map "qui affili un user à un profile (1 ou 2) et enfin tbl_Frm_Profile_Map "qui affili un form à des droits specifiques").

J'aimerais savoir ce que vous pensez du code (pas terminé) ainsi qu'une solution pour que je puisse créer un module qui contient la fonction principale afin de pouvoir simplement la requetter via chaque formulaires des bases de donées et non la réécrire à chaque fois. Donc comment créer mon module et comment l'appeler ???

Je ne connais pas grand-chose en programmation pour être honnete, donc n'hesitez pas à m'envoyé vos idées de code etc. Votre aide m'aiderait énormément UN GRAND MERCI A TOUS.

Ben

Je pense que tous ceux qui écrivent ici, écrivent afin de résoudre des problèmes qu'ils rencontrent, donc personnels... Je ne vois donc pas pourquoi le mien serais un "dépannage perso" :D

Enfin, désolé pour tout ça alors et oui tu as raison un peu risqué de mettre mon adresse ici...

Voiçi mon code: Mon problème est que je voudrais créer un module et faire appel à ce dernier via les codes des tables composant la base de données mais je n'y arrive pas, je ne sais pas trop comment coder ça… Et c'est vrai que si ça peut être utile à d'autre naviguant par là, tant mieux !

Option Compare Database

Private Sub Form_Load()
oProfileID = DLookup("[PROFILE_ID]", "tbl_Users", "[USER_NAME]= '" & Environ("USERNAME") & "'")
oFormID = DLookup("[Form_ID]", "tbl_Forms", "[Form_Name]= '" & Me.Name & "'")

If Not IsNull(oFormID) And Not IsNull(oProfileID) Then

'Create a query to retrieve roles

Dim sQuery As String
Dim oRs As DAO.Recordset
sQuery = "Select * From tbl_Frm_Profile_Map " & _
" Where Form_ID = " & oFormID & _
" And PROFILE_ID = " & oProfileID

'Create and Iterate over a recordset
Set oRs = CurrentDb.OpenRecordset(sQuery)

If Not oRs.EOF Then
While Not oRs.EOF

'Apply rights on the current form
Me.Form.AllowAdditions = oRs("Allow_Insert_YN")
Me.Form.AllowDeletions = oRs("Allow_Delete_YN")
Me.Form.AllowEdits = oRs("Allow_Update_YN")

oRs.MoveNext
Wend

'Custom rights

'Hidden if profile ID = 2
If oProfileID = 1 Then
Me.btnTest.Visible = False
End If

Else
'The current user is not granted on this form !
End If
oRs.Close

Else
'the user or the form is not stored on the database
End If

End Sub

Mon problème est que je voudrais créer un module
Que devra faire ce module ?

et faire appel à ce dernier via les codes des tables composant la base de données
Une table ne peut pas appeler un module, donc il devra être appelé lors d'une action se produisant sur un objet de la base : formulaire, bouton, liste déroulante...

Bonjour Blux,

Merci de me répondre aussi vite..

Alors mon module (ou ma fonction), sera tirer du code que j'ai posté, cette fonction devra comme tu peux le voir, récuperer l'ID de l'utilisateur avec la fonction Environ("USERNAME")(dans ma table user 1, 2, 3 ou4 etc...), tester si l'utilisateur est connu dans la table avec un recordset, puis récupérer le profile (dans ma table profile 1=admin, 2=user) puis selon ce profile affilié des droit à la table en cours.
J'ai aussi créé 2 table "mapping" afin d'affilier un ID de user à un ID de profile et une autre pour affilié l'ID de profile récuperé à chaque ID des forms de la base et attribué des droits différents pour chaque forms (J'aimerais dans l'ideal pouvoir cacher des boutons (delete, insert...) selon le form et le user et son profile mais je ne sais pas trop comment faire et par rapport à mon code ce qu'il me reste... :( )

J'aimerais donc éviter de recopier mon code final mais créer un module et faire appel à ce module quand j'en ai besoin.

Je sais pas si je suis bien clair Blux...

Vu que c'est quelque chose que tu vas appeler une seule fois au lancement de l'application, je ne vois pas pourquoi on devrait en faire un module, tout le code peut (et doit) se mettre sur l'ouverture du formulaire principal.

En fait, je vois tout à fait ce que tu veux dire, mais grace au code que tu as vu, si on place la commande y faisant appel, à l'ouverture de chaque form, selon le profile_ID reconnu, des droits devront être accordés sur le form actuel (avec "acform") quel que soit le nombre de forms non ??????? Car chaque form dans ma table de form, aura un ID et dans mon autre table selon l'ID récuperer au chargement autorise ou non des fonction sur ce form ???? Vois-tu ? DIS MOI QUE C'EST POSSIBLE :D !!!

bonjour,

D'un premier coup d'oeil, il me semble que la syntaxe de Openrecordset n'est pas correcte.

Set rs = CurrentDb.Openrecordset("SELECT * FROM [T_Sous_réseaux COMETE] WHERE [T_Sous_réseaux COMETE].SSres =' " & echange & " ' ")

teste ça.

;o)

je ne sais pas, je n'ai jamais fait comme ça ...

Essais de mettre le résultat du recordset dans des variables :

Dim strNum As Variant // je prends un type variant ne sachant pas le type
Dim strSSres As Variant

blablabla ...

Do Until Not rs.EOF
strNum = rs("Num").value
strSSres = rs("SSres").value
MsgBox strNum & " et " strSSres
rs.MoveNext
Loop

tu codes en VBA sur Access ou avec VB6 ?

La première constante définie le répertoire, la deuxième le nom de ma base. En principe je ne fais pas comme ça, j'ai fait ça un peu à l'arrache, je passe le chemin et le nom en paramètre à la fonction. Dans mon exemple ma base se trouve : " C:\MonRepertoireTest\bd\mabaseTest.mdb.

Pour le message d'erreur, il y a une coquille : c'est Dim Rs As ADODB.RecordSet
dsl

as tu testé la connexion à ta base ? as-tu pensé à ajouter la bonne référence de driver ?