UNE COMBOBOX REMPLIE PAR ACCESS EN VBSCRIPT POUR VOS FORMULAIRES listes, access, triée, combobox, outlook, Source N°39987

Information sur la source

Catégorie :VBScript Classé sous : listes, access, triée, combobox, outlook Niveau : Initié Date de création : 20/10/2006 Date de mise à jour : 30/10/2006 15:00:04 Vu : 6 662

Auteur : dthuler

Ecrire un message privé

Note :
Aucune note

Commentaire sur cette source (3)

Ajouter un commentaire et/ou une note

Description

Construit le contenu d'un contrôle List ou ComboBox à l'aide des données d'un fichier Access en triant les données à la volée (utilisation de l'algorithme modifié du tri par insertion)

J'ai dû pas mal me creuser la tête pour compléter une liste déroulante ComboBox d'un formulaire Outlook avec les donnée d'un fichier Access en les triant! Après avoir transpiré je me dis que cette source pourrait être utile à d'autres...

L'Idée:
Afficher la liste des utilisateurs triée par nom de famille dans un ComboBox.
Cette liste change régulièrement et est gérée par Access.

L'Obligation:
Utilisation d'un code VBScript pour se connecter à la BD.

Le Tri:
La méthode du tri par insertion est celle que vous utiliseriez si vous deviez classer des dossiers dans un classeur ou dossier suspendu, à savoir on recherche où on peut insérer le dossier entre ceux existant pour que le tout reste trié.
L'algorithme peut être légèrement adapté pour permettre le tri "à la volée". Comme ce tri reste rapide pour les petites listes (moins d'un millier d'enregistrement) nous l'utiliserons dans ce script.

Source

'**********************************************************************************
'** Type: SubRoutine
'** Name: BuildList
'** Arguments: Référence Objet
'** Return: Nothing
'**********************************************************************************
'** Developped by: David Thueler
'** Creation Date: 10 Oct. 2006
'** Last Modified: -
'** Purpose: Populate ComboBox object from MDB file and sort the list.
'** ADO Shared Component 3.6 MUST be registered or it will hangs!
'**
'** Usage: Set cboList = Item.GetInspector.ModifiedFormPages("OutlookPageName").Controls("ControlName")
'** BuildList(cboList)
'**********************************************************************************
Sub BuildList(objListe)
Dim rst 'Recordset
Dim dao 'Reference DAO
Dim wks 'Workspace
Dim dbs 'Database
Dim strAccessDir 'Chemin du fichier
Dim strDBName 'Nom de fichier
Dim EmployeeArray 'Enregistrement
Dim arrEmployee() 'Tableau des Employés
Dim indEmployee 'Indice du Tableau
Dim RecEmployee 'Enregistrement en traitement
Dim SortLoop 'Indice de boucle pour le tri par insertion
Dim intSeekPos 'Position de l'insertion
On Error Resume Next
'Définit le nom et emplacement de la base de donnée
strAccessDir = "R:\"
strDBName = strAccessDir & "phonelist.mdb"
'Set reference de la base Access. ADO36 doit être enregistré sinon le moteur doit être modifié en conséquence
Set dao = Application.CreateObject("DAO.DBEngine.36")
If Err > 0 Then
'on quitte le sub si la connexion a échouée
Exit Sub
End If
Set wks = dao.Workspaces(0)
Set dbs = wks.OpenDatabase(strDBName)
'Lien sur la table qui nous intéresse
Set rst = dbs.OpenRecordset("Employees")
'On parcours les enregistrements de la table
indEmployee = 0
With rst
.MoveFirst
While Not .EOF
EmployeeArray = rst.GetRows(1)
'On ajuste la dimension du tableau (très important dans le cas de ce script!)
ReDim Preserve arrEmployee(indEmployee)
'On construit la chaîne de caractère avec les enregistrements intéressants.
'Dans notre cas, [Nom de famille] [Prénom] ([Téléphone]) à l'aide des indices
RecEmployee = EmployeeArray(1,0) & " "
RecEmployee = RecEmployee & EmployeeArray(0,0) & " ("
RecEmployee = RecEmployee & Left(EmployeeArray(2,0),4) & ")"
'On insert l'enregistrement à la bonne place dans la liste
For SortLoop = 0 To indEmployee
If StrComp(RecEmployee, arrEmployee(SortLoop), vbTextCompare)<0 Then
intSeekPos = SortLoop
Exit For
End If
Next
For SortLoop=indEmployee To intSeekPos+1 step -1
arrEmployee(SortLoop)=arrEmployee(SortLoop-1)
Next
arrEmployee(intSeekPos)=RecEmployee
indEmployee = indEmployee + 1
Wend
.Close
End With
'On met à jour la ComboBox
objListe.List() = arrEmployee
End Sub

'**********************************************************************************
'** Type:          SubRoutine
'** Name:          BuildList
'** Arguments:     Référence Objet
'** Return:        Nothing
'**********************************************************************************
'** Developped by: David Thueler
'** Creation Date: 10 Oct. 2006
'** Last Modified: -
'** Purpose:       Populate ComboBox object from MDB file and sort the list.
'**                ADO Shared Component 3.6 MUST be registered or it will hangs!
'**
'** Usage:         Set cboList = Item.GetInspector.ModifiedFormPages("OutlookPageName").Controls("ControlName")
'**                BuildList(cboList)
'**********************************************************************************
Sub BuildList(objListe)
    Dim rst		'Recordset
    Dim dao		'Reference DAO
    Dim wks		'Workspace
    Dim dbs		'Database
    Dim strAccessDir	'Chemin du fichier
    Dim strDBName	'Nom de fichier
    Dim EmployeeArray	'Enregistrement
    Dim arrEmployee()	'Tableau des Employés
    Dim indEmployee	'Indice du Tableau
    Dim RecEmployee	'Enregistrement en traitement
    Dim SortLoop	'Indice de boucle pour le tri par insertion
    Dim intSeekPos	'Position de l'insertion

    On Error Resume Next
 
    'Définit le nom et emplacement de la base de donnée
    strAccessDir = "R:\"
    strDBName = strAccessDir & "phonelist.mdb"
 
    'Set reference de la base Access. ADO36 doit être enregistré sinon le moteur doit être modifié en conséquence
    Set dao = Application.CreateObject("DAO.DBEngine.36")
    If Err > 0 Then
	'on quitte le sub si la connexion a échouée
        Exit Sub
    End If
    Set wks = dao.Workspaces(0)
    Set dbs = wks.OpenDatabase(strDBName)
 
    'Lien sur la table qui nous intéresse
    Set rst = dbs.OpenRecordset("Employees")

    'On parcours les enregistrements de la table
    indEmployee = 0
    With rst
        .MoveFirst
	While Not .EOF
	    EmployeeArray = rst.GetRows(1)
	    'On ajuste la dimension du tableau (très important dans le cas de ce script!)
	    ReDim Preserve arrEmployee(indEmployee)

	    'On construit la chaîne de caractère avec les enregistrements intéressants.
	    'Dans notre cas, [Nom de famille] [Prénom] ([Téléphone]) à l'aide des indices
	    RecEmployee = EmployeeArray(1,0) & " "
	    RecEmployee = RecEmployee & EmployeeArray(0,0) & " ("
	    RecEmployee = RecEmployee & Left(EmployeeArray(2,0),4) & ")"

	'On insert l'enregistrement à la bonne place dans la liste
	    For SortLoop = 0 To indEmployee
		If StrComp(RecEmployee, arrEmployee(SortLoop), vbTextCompare)<0 Then
		    intSeekPos = SortLoop
	    	    Exit For
		End If
	    Next
	    For SortLoop=indEmployee To intSeekPos+1 step -1
		arrEmployee(SortLoop)=arrEmployee(SortLoop-1)
	    Next
	    arrEmployee(intSeekPos)=RecEmployee
	
	    indEmployee = indEmployee + 1
	Wend
    	.Close
    End With

    'On met à jour la ComboBox
    objListe.List() = arrEmployee
End Sub

Conclusion

Pas de bug connus.

Donnez-moi votre feed-back, je programme souvent ces temps en VBScript et j'aimerais beaucoups connaître vos critiques, remarques, félicitations et encouragements ;-)

Dites aussi si vous avez des suggestions, ça m'intéresse toujours!

Historique

30 octobre 2006 15:00:04 :: Correction d'un bug qui provoquait un saut d'enregistrement sur le moteur DAO36.

Sources du même auteur

Toutes les sources de dthuler

Sources de la même categorie

Toutes les sources de la catégorie VBScript

Sources en rapport avec celle ci

Commentaires

Commentaire de mitsh666 le 22/03/2007 13:26:58

ça à l'air sympa ce que tu fais, mais c'est du VB? pas du VBS?
Cela dis, je suis débutant VBScript et ne connaît pas Access. Je ne peux donc pas donner de feed-back à ton boulot... désolé.
Pour te dire que je suis débutant en VBScript, je n'arrive pas à écrire quelque chose dans une combobox avec du VBScript. C'est l'horreur...
Commentaire de dthuler le 22/03/2007 16:17:51

Salut,

Merci pour le commentaire :-) Tu as raison, c'est du VBS, comme expliqué dans la description, posté dans VB car pas de catégorie VBS séparée (au moment du post du moins...)

L'intérêt de ce code est de montrer comment résoudre ton problème car c'est un casse-tête de premier ordre la méthode AddItem n'existant pas;

Effectivement, il faut partir du principe qu'une combolist est un tableau d'élément. Le moyen de faire est donc de créer un tableau d'élément Dim Tableau() puis une fois complété (ligne 53 et 55), l'assigner à la propriété list() (ligne 81).

Si jamais tu as une question y relatif, n'hésite pas...

David
Commentaire de razette le 12/09/2007 18:05:21

C'est justement le code que je cherche !! On peut l'adapter pour excel ? (je suis novice en prog sous vb)
Merci

Ajouter un commentaire

Discussions en rapport avec ce code source

liaison outlook et access par boris

Outlook et Access 2000 par taz

Consulter une base Access depuis Outlook via MAPI par David

Lier deux liste sous access par Ph_D

sous visual basic 6.0 combobox < liens vers une table access par BOP

Listes dans access par BasicInstinct

import/export automatisé entre outlook et access par raphaelle37

ACCESS ET OUTLOOK par pepe013

Synchroniser une table access avec les contact outlook. par jff27

liaison entre outlook et access par snoop