Création d'une source de données dynamiquement

Signaler
Messages postés
2
Date d'inscription
vendredi 14 juin 2002
Statut
Membre
Dernière intervention
14 juin 2002
-
Messages postés
110
Date d'inscription
jeudi 9 mai 2002
Statut
Membre
Dernière intervention
11 mars 2010
-
Bonjour
Je lie une BD à un contrôle DataListBox par l'intermédiaire d'un contrôle adodc. J'associe au contrôle adodc une source de données système. Sur mon ordinateur, ca marche mais pour le faire tourner sur un autre ordinateur, il faut à chaque fois recréer à la main la source de données.

Le but est que cela se fasse automatiquement pour ne pas avoir à le faire sur tous les ordinateurs ou j'installerai le prog.

Comment faire??

1 réponse

Messages postés
110
Date d'inscription
jeudi 9 mai 2002
Statut
Membre
Dernière intervention
11 mars 2010
1
voici mon code pour une de mes applications.. regarde si ca peut t'aider...

Option Explicit

Private Cat As New ADOX.Catalog
Private Tbl As New ADOX.Table
Private cmdado As New ADODB.command
Private rsProject As New ADODB.Recordset
Private rsImages As New ADODB.Recordset
Private rsData As New ADODB.Recordset

Public Function CreateDB(link As String) As Boolean

On Error GoTo Annulation
Cat.Create "provider=microsoft.jet.oledb.3.51;" & "Data source =" & link & ";"

With Tbl
.Name = "Project"
.Columns.append "Log Nb", adChar, 50
.Columns.append "Sample Nb", adChar, 50
.Columns.append "Name", adChar, 50
.Columns.append "Path", adChar, 255
.Columns.append "Images From", adChar, 255

End With

Cat.Tables.append Tbl
Set Tbl = Nothing

With Tbl
.Name = "Images"
.Columns.append "State", adBoolean
.Columns.append "Calcul", adBoolean
.Columns.append "Name", adChar, 50
.Columns.append "Dimension", adChar, 50
End With
Cat.Tables.append Tbl
Set Tbl = Nothing

With Tbl
.Name = "Data"

.Columns.append "Name", adChar, 50
.Columns.append "Indice", adInteger
.Columns.append "Wall Area", adDouble
.Columns.append "Lumen Area", adDouble
.Columns.append "Fibre Per", adDouble
.Columns.append "Lumen Per", adDouble
.Columns.append "CenterLine", adDouble
.Columns.append "Fibre Width", adDouble
.Columns.append "Fibre Thick", adDouble
.Columns.append "Max Diam", adDouble
.Columns.append "Min Diam", adDouble
.Columns.append "Mean Diam", adDouble
.Columns.append "Aspect Ratio", adDouble
End With
Cat.Tables.append Tbl
Set Tbl = Nothing

ActiveDB
CreateDB = True

Exit Function
Annulation:
CreateDB = False
MsgBox "CreateDB Error! " & error, vbExclamation, "ERROR"
CloseDB

End Function

Private Function ActiveDB()

On Error GoTo Annulation

cmdado.ActiveConnection = Cat.ActiveConnection
cmdado.CommandText = " select * from Project"

rsProject.CursorLocation = adUseClient
rsProject.CursorType = adOpenDynamic
rsProject.LockType = adLockOptimistic
rsProject.Open cmdado

cmdado.CommandText = " select * from Images"
rsImages.CursorLocation = adUseClient
rsImages.CursorType = adOpenDynamic
rsImages.LockType = adLockOptimistic
rsImages.Open cmdado

cmdado.CommandText = " select * from Data " ' order by name indice asc"
rsData.CursorLocation = adUseClient
rsData.CursorType = adOpenDynamic
rsData.LockType = adLockOptimistic
rsData.Open cmdado

ActiveDB = True
Exit Function

Annulation:
ActiveDB = False
MsgBox "OpenDB Error! " & error, vbExclamation, "ERROR"

CloseDB

End Function

Public Function OpenDB(link As String) As Boolean

On Error GoTo Annulation
Cat.ActiveConnection = "provider=microsoft.jet.oledb.3.51;" & "Data source =" & link & ";"

If ActiveDB = True Then
OpenDB = True
Else
OpenDB = False
End If
Exit Function
Annulation:
OpenDB = False
MsgBox "OpenDB Error! " & error, vbExclamation, "ERROR"

CloseDB

End Function

Public Function CloseDB()
On Error GoTo Annulation

Set Cat = Nothing
Set Tbl = Nothing
Set cmdado = Nothing
Set rsProject = Nothing
Set rsImages = Nothing
Set rsData = Nothing

Exit Function
Annulation:

MsgBox "CloseDB Error! " & error, vbExclamation, "ERROR"

End Function
0