F
fodjio
Guest
Bonjour,
je m'adresse à tous les connaisseurs z'et connaisseuses en ADO
lorsque j'utilise la commande 'connection.Open' , celà ouvre le fichier où se situent les données. N'y a-t-il pas quelque chose à faire pour empêcher celà ???
Code :
***********************************************************
Const NomPlage As String = "BdD"
Dim i As Byte
Dim NomFichier As String
Dim RequeteSQL As String
Dim Reponse As Long
Dim ConnectionADODB As ADODB.Connection
Dim RecordsetADODB As ADODB.Recordset
Dim CommandADODB As ADODB.Command
Depart:
RequeteSQL = "SELECT * FROM [" & NomPlage & "] " _
& "WHERE Tournée IS NOT NULL " _
& "ORDER BY Jour, Tournée, Produit, Référence, Teinte, Côté"
'Connection à la base de données
On Error GoTo MauvaiseConnection
Set ConnectionADODB = New ADODB.Connection
ConnectionADODB.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & FichierSource(i) & ";" & _
"Extended Properties=""Excel 8.0;HDR=yes;IMEX=1;"""
On Error GoTo 0
Set CommandADODB = New ADODB.Command
With CommandADODB
.CommandType = adCmdText
.CommandText = RequeteSQL
.ActiveConnection = ConnectionADODB
End With
Set RecordsetADODB = CommandADODB.Execute
ActiveSheet.Range("A2").CopyFromRecordset RecordsetADODB
RecordsetADODB.Close
ConnectionADODB.Close
Set CommandADODB = Nothing
Set RecordsetADODB = Nothing
Set ConnectionADODB = Nothing
Call ConvNumericBase(TabBase(i).Name)
'Gestion de la barre de progression
UserForm1.Caption = "Chargement des bases de données..."
UserForm1.brgBarre.Value = (i / UBound(TabBase)) * 100
Exit Sub
MauvaiseConnection:
Unload UserForm1
Reponse = MsgBox("La connection avec la base de données à été interrompue" _
, vbCritical + vbRetryCancel, "Echec de la connection")
If Reponse = vbRetry Then
GoTo Depart
End If
********************************************************
Dédicace à Michel_M qui m'a aidé à amélioré ce script
Merci beaucoup...
je m'adresse à tous les connaisseurs z'et connaisseuses en ADO
lorsque j'utilise la commande 'connection.Open' , celà ouvre le fichier où se situent les données. N'y a-t-il pas quelque chose à faire pour empêcher celà ???
Code :
***********************************************************
Const NomPlage As String = "BdD"
Dim i As Byte
Dim NomFichier As String
Dim RequeteSQL As String
Dim Reponse As Long
Dim ConnectionADODB As ADODB.Connection
Dim RecordsetADODB As ADODB.Recordset
Dim CommandADODB As ADODB.Command
Depart:
RequeteSQL = "SELECT * FROM [" & NomPlage & "] " _
& "WHERE Tournée IS NOT NULL " _
& "ORDER BY Jour, Tournée, Produit, Référence, Teinte, Côté"
'Connection à la base de données
On Error GoTo MauvaiseConnection
Set ConnectionADODB = New ADODB.Connection
ConnectionADODB.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & FichierSource(i) & ";" & _
"Extended Properties=""Excel 8.0;HDR=yes;IMEX=1;"""
On Error GoTo 0
Set CommandADODB = New ADODB.Command
With CommandADODB
.CommandType = adCmdText
.CommandText = RequeteSQL
.ActiveConnection = ConnectionADODB
End With
Set RecordsetADODB = CommandADODB.Execute
ActiveSheet.Range("A2").CopyFromRecordset RecordsetADODB
RecordsetADODB.Close
ConnectionADODB.Close
Set CommandADODB = Nothing
Set RecordsetADODB = Nothing
Set ConnectionADODB = Nothing
Call ConvNumericBase(TabBase(i).Name)
'Gestion de la barre de progression
UserForm1.Caption = "Chargement des bases de données..."
UserForm1.brgBarre.Value = (i / UBound(TabBase)) * 100
Exit Sub
MauvaiseConnection:
Unload UserForm1
Reponse = MsgBox("La connection avec la base de données à été interrompue" _
, vbCritical + vbRetryCancel, "Echec de la connection")
If Reponse = vbRetry Then
GoTo Depart
End If
********************************************************
Dédicace à Michel_M qui m'a aidé à amélioré ce script
Merci beaucoup...