Pouvoir me connecter sur un serveur Sql

Bonjour

J'ai plusieurs question.

---------------------------------------------------------------
Q 1. Quel est la manière d'ouvrir une base SQL
En Access et ODBC je n'ai pas de problème
Ma procédure va elle fonctionné?


'reférence
'Microsoft ADO Ext. 2.1 pour DDL et Sécurité

'reférence pour L'ADOB
'Microsoft ActiveX Data Objets 2.1 Library


On Error GoTo err_ouvreBase

If DB.State = adStateClosed Then

Select Case strBaseDeDonnéeType
Case "ACCESS"
'Access
DB.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=
" & strCheminBase & strNomBase
Case "ODBC"
'ODBC
DB.Open "Provider=MSDASQL.1;Persist Security
Info=False;Data Source=surgest;Initial Catalog=" &
strCheminBase & strNomBase
Case "SQLServeur"
'DB.Open "Provider=SQLOLEDB;data Source=<name of your SQL
Server>;"
' DB.Open "Provider=SQLOLEDB;data Source=" & strCheminBase &
strNomBase

'ou
'Syntaxe sans DSN (connexion sans DSN) :
'"[Provider=MSDASQL;] DRIVER=pilote; SERVER=serveur;
DATABASE=basededonnées; UID=utilisateur; PWD=motdepasse"
End Select

End If
----------------------------------------------------------------------------
---------------------
Q 2. Si une erreur se produit en ouvrant la base c'est que celle ci n'existe
pas alors je la crée
Ma procédure va elle fonctionné?



On Error GoTo err_ouvreBase
....Ouverture de la base (Q1)


err_ouvreBase:

'La base n'existe pas
If Err.Number = 3024 Or Err.Number = -2147467259 Then
Unload Frm_logo
frmProgresseBar.Visible = False

frmProgresseBar.ProgressBar1.Min = 1
frmProgresseBar.ProgressBar1.Max = intNbTable
frmProgresseBar.ProgressBar1.Value = 1

frmProgresseBar.Label1(2) = "Création de la base"
frmProgresseBar.Refresh
frmProgresseBar.fraScrollBar.Visible = True
frmProgresseBar.Refresh
frmProgresseBar.Visible = True
On Error GoTo 0
LimiteDeTemps = Time + MyTime

Do While Time < LimiteDeTemps

Loop

CreateDatabaseX (strCheminBase & strNomBase)
EcrireDansINI strFichierINI, "Configuration", "Base creer", "Oui"

Resume

End If

Exit Function
********************************************
Sub CreateDatabaseX(NomDeLaBase As String)

Dim wrkDefault As Workspace
Dim dbsNew As Database
Dim prpLoop As Property

' Obtient l'objet Workspace par défaut.
Set wrkDefault = DBEngine.Workspaces(0)

' Vérifie qu'aucun fichier ne porte le nom de la
' nouvelle
' base de données.




If Dir(NomDeLaBase) <> "" Then Kill NomDeLaBase




' Crée une nouvelle base de données cryptée avec
' l'ordre de classement précisé.

Set dbsNew = wrkDefault.CreateDatabase(NomDeLaBase, _
dbLangGeneral, dbEncrypt)

If EnDebug Then

With dbsNew

Debug.Print "Propriétés de " & .Name

' Énumère la collection Properties du nouvel
' objet Database.
For Each prpLoop In .Properties

If prpLoop <> "" Then Debug.Print " " & _
prpLoop.Name & " = " & prpLoop

Next prpLoop

End With

End If

dbsNew.Close

End Sub

----------------------------------------------------------------------------
---------------------
Q3. Quand j'ouvre une table si elle n'existe pas je la crée.
Ma procédure va elle fonctionné?



Dim r As ADODB.Recordset
Set r = New ADODB.Recordset
'****************************************************************
'*********************************** Numérisation
'****************************************************************
On Error GoTo err_Numerisation
r.Open "SELECT * FROM [Numerisation]", DB, adOpenStatic,
adLockOptimistic
Frm_logo.ImageG.Left = Frm_logo.ImageG.Left - 100

r.Close
*********************
err_Numerisation:
frmProgresseBar.ProgressBar1.Value = frmProgresseBar.ProgressBar1.Value
+ 1
frmProgresseBar.Label1(2) = "Création de la table: [Numérisation]"
frmProgresseBar.Refresh
CreateFieldX ("[Numerisation]")
On Error GoTo 0
LimiteDeTemps = Time + MyTime

Do While Time < LimiteDeTemps

Loop

frmProgresseBar.Refresh
Resume


*************

Sub CreateFieldX(tbl As String)

Dim dbsNorthwind As Database
Dim tdfNew As TableDef
Dim fldLoop As Field
Dim prpLoop As Property
Dim idx As Index
On Error GoTo err_création
Set dbsNorthwind = OpenDatabase(strCheminBase & strNomBase)

Select Case tbl
'*****************************************
'*** Dossier
'*****************************************
Case "[tbDossier]"
Set tdfNew = dbsNorthwind.CreateTableDef("tbDossier")

' Crée et ajoute de nouveaux objets Field pour le
' nouvel objet TableDef.
With tdfNew

.Fields.Append .CreateField("No dossier", dbText,
intLongueurNoDossier)
.Fields.Append .CreateField("txtDateOuverture", dbDate)
.Fields.Append .CreateField("boolHeureDateConstat", dbBoolean)
.Fields.Append .CreateField("Jour", dbInteger)
.Fields.Append .CreateField("No reference", dbDouble)

End With

Set idx = tdfNew.CreateIndex("PrimaryKey")

With idx
.Fields.Append tdfNew.CreateField("No dossier")
End With

tdfNew.Indexes.Append idx

Set idx = tdfNew.CreateIndex("No reference")

With idx
.Fields.Append tdfNew.CreateField("No reference")
End With

tdfNew.Indexes.Append idx
dbsNorthwind.TableDefs.Append tdfNew

If EnDebug Then

Debug.Print "Propriétés des nouveaux champs de " & tdfNew.Name

' Énumère la collection Fields pour afficher les
' propriétés des nouveaux objets Field.
For Each fldLoop In tdfNew.Fields

Debug.Print " " & fldLoop.Name

For Each prpLoop In fldLoop.Properties

' Toute tentative de lecture de propriétés
' non valides dans le contexte de TableDefs
' provoquera une erreur.
On Error Resume Next
Debug.Print " " & prpLoop.Name & " - " & IIf(prpLoop
= "", "[vide]", prpLoop)
On Error GoTo 0

Next prpLoop

Next fldLoop

End If

dbsNorthwind.Close
Exit Sub
err_création:
intRep = Message_Erreur(Err, Err.description, "CreateFieldX")
Resume


----------------------------------------------------------------------------
----------
Q3. Ici je vérifie le nombre de champs pour version antérieur
Ma procédure va elle fonctionné?

'*****************************************
'*** Vérifier Nombre De Champs
'*** Pour version antérieure
'*****************************************

If LireDansINI(strFichierINI, "Verifier champs", "Base", " ") <>
App.Major & "." & App.Minor & "." & App.Revision Then
Frm_logo.lblChargement = "Vérification de la structure des bases..."
Frm_logo.ImageG.Left = Frm_logo.ImageG.Left - 100

Frm_logo.lblChargement.Refresh


VérifierNombreDeChampsDossier

Frm_logo.ImageG.Left = Frm_logo.ImageG.Left - 100


EcrireDansINI strFichierINI, "Verifier champs", "Base", App.Major &
"." & App.Minor & "." & App.Revision
End If


******************
Public Sub VérifierNombreDeChampsDossier()

' Ouvre la table
Dim r As ADODB.Recordset
Dim x, y As Integer
Dim Nom(7)
Dim trouver As Boolean
Const TotalNouveauChamps As Integer = 7



Screen.MousePointer = vbHourglass

Nom(1) = "Jour"
Nom(2) = "Mois"
Nom(3) = "Année"
Nom(4) = "BraquetteHeure"
Nom(5) = "Jour de la semaine"
Nom(6) = "Confidentiel"
Nom(7) = "cmbLocal"


RECOMMENCE:

On Error GoTo err_VérifierNombreDeChampsDossier
Screen.MousePointer = vbHourglass
If DB.State = adStateClosed Then

DB.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &
strCheminBase & _
strNomBase

End If

Set r = New ADODB.Recordset
r.CursorType = adOpenKeyset
r.LockType = adLockOptimistic

r.Open "SELECT * FROM [tbDossier]", DB, , , adCmdText

'Manque des champs
'VérifierChamps
If R.Fields.Count < 25 Then
For y = 1 To TotalNouveauChamps
trouver = False
For x = 0 To r.Fields.Count - 1
If UCase(r.Fields(x).Name) = UCase(Nom(y)) Then
trouver = True
Exit For
End If
Next
If Not trouver Then
GoSub ConstruireChamps
GoSub RECOMMENCE
End If
Next y
End If


Exit_VérifierNombreDeChampsDossier:
Screen.MousePointer = vbNormal
Exit Sub

err_VérifierNombreDeChampsDossier:
strTemp = "VérifierNombreDeChampsDossier: " & "Module GestionBase"
intRep = Message_Erreur(Err, Error$, strTemp)
Resume Exit_VérifierNombreDeChampsDossier
Resume


ConstruireChamps:
r.Close
DB.Close
Set DB = Nothing

Dim dbsNorthwind As Database
Set dbsNorthwind = OpenDatabase(strCheminBase + strNomBase)

Dim tdfTABLE As TableDef
Set tdfTABLE = dbsNorthwind.TableDefs![tbDossier]

' Ajoute le champ
strTemp = Nom(y)
Select Case y
Case 1, 2, 3, 4, 5, 7
AppendDeleteField tdfTABLE, "APPEND", strTemp, dbInteger
Case 6
AppendDeleteField tdfTABLE, "APPEND", strTemp, dbBoolean
' Case 7
' AppendDeleteField tdfTABLE, "APPEND", strTemp, dbText, 25


End Select
dbsNorthwind.Close
Return

End Sub



J'espère que j'ai été assez clair

--
Merci pour les réponse
--
Yves K

Courriel : yveskelley@sympatico.ca