Liste des formulaires d'une base
polop
Messages postés
9
Date d'inscription
mardi 4 juin 2002
Statut
Membre
Dernière intervention
24 juin 2006
-
24 juin 2006 à 10:42
cs_JMO Messages postés 1854 Date d'inscription jeudi 23 mai 2002 Statut Membre Dernière intervention 24 juin 2018 - 24 juin 2006 à 15:24
cs_JMO Messages postés 1854 Date d'inscription jeudi 23 mai 2002 Statut Membre Dernière intervention 24 juin 2018 - 24 juin 2006 à 15:24
1 réponse
cs_JMO
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
27
24 juin 2006 à 15:24
24 juin 2006 à 15:24
Bonjour,
Exemple, en vbs, a adapté en VB6 qui permet d'ouvrir
plusieurs formulaires selon un nom incomplétement connu,
il suffit donc de remplacer le Do Until par un For Each....Next
Toutes les tables y compris systèmes seront enumérées.
jean-marc
OuvertureBaseJor BaseJor,ObjTextStream,usine,ext_usine
LectureTableJor BaseJor,ObjTextStream,usine,ext_usine
Function OuvertureBaseJor(BaseJor, ObjTextStream, usine,ext_usine)
Const adSchemaTables = &h14
Set Db = CreateObject("ADODB.Connection")
Db.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & BaseJor
Set Rs = Db.OpenSchema(adSchemaTables)
End Function
Function LectureTableJor(BaseJor, ObjTextStream, usine,ext_usine)
Dim ext_imtp, ext_tpea, ext_tpeb
Do Until Rs.EOF
If Left( Rs.Fields("TABLE_NAME").Value , 3) = "J_X" Then
MyTable = Rs.Fields("TABLE_NAME").Value
MyQuery = "SELECT LINE_TEXT FROM " & MyTable
Set Rst = CreateObject("ADODB.Recordset")
Rst.Open MyQuery ,Db
Do While Not Rst.EOF
Dim cpt, job If cpt 0 Then job Mid(Rst.Fields(0), 7, 8)
cpt = 1
If job = "TDS-" & usine Then ObjTextStream.WriteLine Trim(Rst.Fields(0))
Rst.MoveNext
Loop
Rst.Close
End if
Rs.MoveNext
Loop
End Function
Exemple, en vbs, a adapté en VB6 qui permet d'ouvrir
plusieurs formulaires selon un nom incomplétement connu,
il suffit donc de remplacer le Do Until par un For Each....Next
Toutes les tables y compris systèmes seront enumérées.
jean-marc
OuvertureBaseJor BaseJor,ObjTextStream,usine,ext_usine
LectureTableJor BaseJor,ObjTextStream,usine,ext_usine
Function OuvertureBaseJor(BaseJor, ObjTextStream, usine,ext_usine)
Const adSchemaTables = &h14
Set Db = CreateObject("ADODB.Connection")
Db.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & BaseJor
Set Rs = Db.OpenSchema(adSchemaTables)
End Function
Function LectureTableJor(BaseJor, ObjTextStream, usine,ext_usine)
Dim ext_imtp, ext_tpea, ext_tpeb
Do Until Rs.EOF
If Left( Rs.Fields("TABLE_NAME").Value , 3) = "J_X" Then
MyTable = Rs.Fields("TABLE_NAME").Value
MyQuery = "SELECT LINE_TEXT FROM " & MyTable
Set Rst = CreateObject("ADODB.Recordset")
Rst.Open MyQuery ,Db
Do While Not Rst.EOF
Dim cpt, job If cpt 0 Then job Mid(Rst.Fields(0), 7, 8)
cpt = 1
If job = "TDS-" & usine Then ObjTextStream.WriteLine Trim(Rst.Fields(0))
Rst.MoveNext
Loop
Rst.Close
End if
Rs.MoveNext
Loop
End Function
