|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic (Strings de Conexões)
|
|
 |
Título da Dica: Biblioteca de Acesso a Dados
|
 |
|
|
|
Postada em 17/1/2004 por Mateus
'REFERENCIAS:
'Microsoft Activex Data Objects 2.X Library
'Microsoft Activex Data Objects Recordset 2.X Library
'Microsoft ADO ext. 2.X for DDL and Security
'FUNÇÕES EM ADO USANDO O JET4.0
'---------------------------------------CÓDIGO ------------------------------------
'JET OLEDB CONSTANTES
' Jet Engine Versions; used with the
' Jet OLEDB:Engine Type property.
Public Enum opgJetEngineType
UNKNOWN = 0
JET10 = 1
JET11 = 2
JET20 = 3
JET3X = 4
JET4X = 5
DBASE3 = 10
DBASE4 = 11
DBASE5 = 12
EXCEL30 = 20
EXCEL40 = 21
EXCEL50 = 22
EXCEL80 = 23
EXCEL90 = 24
EXCHANGE4 = 30
LOTUSWK1 = 40
LOTUSWK3 = 41
LOTUSWK4 = 42
PARADOX3X = 50
PARADOX4X = 51
PARADOX5X = 52
PARADOX7X = 53
TEXT1X = 60
HTML1X = 70
End Enum
' Bulk; used with the Jet OLEDB:Global Partial Bulk Ops and
' Jet OLEDB:Partial Bulk Ops properties.
Public Enum opgBulkOps
BULKOPS_DEFAULT = 0
PARTIAL = 1 ' Allow partial completion of the bulk ' operation. Could result in inconsistent ' changes since operations on some rows could ' succeed and others could fail. NOPARTIAL = 2 ' Fail the bulk operation on a single error. End Enum
' operation. Could result in inconsistent ' changes since operations on some rows could
' succeed and others could fail.
NOPARTIAL = 2 ' Fail the bulk operation on a single error.
End Enum
' Database locking mode; used with the
' Jet OLEDB:Database Locking Mode property.
Public Enum opgDBLockMode
LOCK_PAGE = 0
LOCK_ROW = 1
End Enum
' Connection shutdown mode; used with the
' Jet OLEDB:Connection Control property.
Public Enum opgShutdownMode
PASSIVESHUTDOWN = 1
Normal = 2
End Enum
' Security GUIDS for Access objects.
Global Const SECURE_FORMS = "{c49c842e-9dcb-11d1-9f0a-00c04fc2c2e0}"
Global Const SECURE_REPORTS = "{c49c8430-9dcb-11d1-9f0a-00c04fc2c2e0}"
Global Const SECURE_MACROS = "{c49c842f-9dcb-11d1-9f0a-00c04fc2c2e0}"
Global Const SECURE_MODULES = "{c49c8432-9dcb-11d1-9f0a-00c04fc2c2e0}"
' Jet OLE DB provider-defined schema rowsets.
Global Const REPLPARTIALFILTERLIST = "{e2082df0-54ac-11d1-bdbb-00c04fb92675}"
Global Const REPLCONFLICTTABLES = "{e2082df2-54ac-11d1-bdbb-00c04fb92675}"
Global Const USERROSTER = "{947bb102-5d43-11d1-bdbf-00c04fb92675}"
Global Const ISAMStats = "{8703b612-5d43-11d1-bdbf-00c04fb92675}"
' ABERTURA DE BASES DE DADOS ADO
'ABRIR BASE DE DADOS COMO SHARED
Sub OpenDBShared(strDBPath As String)
Dim cnnDB As ADODB.Connection
' Initialize Connection object.
Set cnnDB = New ADODB.Connection
' Specify the Microsoft Jet 4.0 provider and then open the
' database specified in the strDBPath variable.
With cnnDB
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Open strDBPath ' Add your own code to work with database here.
End With ' Close Connection object and destroy object variable.
cnnDB.Close
Set cnnDB = Nothing
End Sub
' ABRIR BASE DE DADOS COMO READ-ONLY
Sub OpenDBReadOnly(strDBPath As String)
Dim cnnDB As ADODB.Connection
Set cnnDB = New ADODB.Connection
With cnnDB
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Mode = adModeRead
.Open strDBPath
' Add your own code to work with database here.
End With
cnnDB.Close
Set cnnDB = Nothing
End Sub
' ABRIR CONEXAO JET
Function GetJetConnection(strDBPath As String, _
lngMode As ADODB.ConnectModeEnum, _
Optional strDBPwd As String, _
Optional strSysDBPath As String, _
Optional strUserID As String, _
Optional strUserPwd As String, _
Optional lngEngineType As opgJetEngineType) _
As ADODB.Connection
Dim cnnDB As ADODB.Connection
Set cnnDB = New ADODB.Connection
With cnnDB
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Mode = lngMode
.Properties("Jet OLEDB:Database Password") = strDBPwd
.Properties("Jet OLEDB:System Database") = strSysDBPath
.Properties("Jet OLEDB:Engine Type") = lngEngineType
.Open ConnectionString:=strDBPath, _
UserID:=strUserID, _
Password:=strUserPwd
End With
Set GetJetConnection = cnnDB
End Function
' IMPRIMIR A STRING DE CONEXAO CORRENTE
Sub PrintCurrentConnectString()
Dim cnnDB As ADODB.Connection
Set cnnDB = New ADODB.Connection
' Get connection to current database.
'Set cnnDB = CurrentProject.Connection
Debug.Print cnnDB.ConnectionString
Set cnnDB = Nothing
End Sub
' ABRIR BASE DE DADOS EXCEL
Sub OpenExcelDatabase(strDBPath As String)
Dim cnnDB As ADODB.Connection
Set cnnDB = New ADODB.Connection
' Specify Excel 8.0 by using the Extended Properties
' property, and then open the Excel file specified
' by strDBPath.
With cnnDB
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Properties("Extended Properties") = "Excel 8.0"
.Open strDBPath
Debug.Print .ConnectionString
.Close
End With
Set cnnDB = Nothing
End Sub
' ABRIR BASE DE DADOS HTML
Sub OpenHTMLDatabase(strHTMLPath As String)
Dim cnnDB As ADODB.Connection
Set cnnDB = New ADODB.Connection
With cnnDB
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Properties("Extended Properties") = "HTML Import"
.Open "DATABASE=" & strHTMLPath & ";HDR=YES"
Debug.Print .ConnectionString
.Close
End With
Set cnnDB = Nothing
End Sub
' ABRIR DATA LINK
Sub OpenDataLink(strUDLPath As String)
Dim cnnDB As ADODB.Connection
Set cnnDB = New ADODB.Connection
With cnnDB
.Open "File Name=" & strUDLPath
Debug.Print cnnDB.ConnectionString
.Close
End With
Set cnnDB = Nothing
End Sub
' CRIAR E MODIFICAR BASES DE DADOS
' CRIAR BASE DE DADOS ACCESS
Sub CreateAccessDatabase(strDBPath As String)
Dim catNewDB As ADOX.Catalog
Set catNewDB = New ADOX.Catalog
catNewDB.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strDBPath
Debug.Print catNewDB.ActiveConnection
Set catNewDB = Nothing
End Sub
' CRIAR UMA BASE DE DADOS DE SISTEMA
Sub CreateSystemDatabase(strDBPath As String)
Dim catNewDB As ADOX.Catalog
Set catNewDB = New ADOX.Catalog
catNewDB.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Jet OLEDB:Create System Database=True;" & _
"Data Source=" & strDBPath
Debug.Print catNewDB.ActiveConnection
Set catNewDB = Nothing
End Sub
' LISTAR TABELAS ACCESS 1
Sub ListAccessTables(strDBPath As String)
Dim catDB As ADOX.Catalog
Dim tblList As ADOX.Table
Set catDB = New ADOX.Catalog
' Open the Catalog object.
catDB.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strDBPath
' Loop through all the tables, but not queries, and
' print their names and types.
For Each tblList In catDB.Tables
If tblList.Type <> "VIEW" Then
Debug.Print tblList.Name & vbTab & tblList.Type
End If
Next
Set catDB = Nothing
End Sub
' LISTAR TABELAS ACCESS 2
Sub ListAccessTables2(strDBPath As String)
Dim cnnDB As ADODB.Connection
Dim rstList As ADODB.Recordset
Set cnnDB = New ADODB.Connection
' Open the Connection object.
With cnnDB
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Open strDBPath
End With
' Open the tables schema Recordset object.
Set rstList = cnnDB.OpenSchema(adSchemaTables)
' Loop through the recordset and print the names
' and types in the Immediate pane.
With rstList
Do While Not .EOF
If .Fields("TABLE_TYPE") <> "VIEW" Then
Debug.Print .Fields("TABLE_NAME") & vbTab & _
.Fields("TABLE_TYPE")
End If
.MoveNext
Loop
End With
cnnDB.Close
Set cnnDB = Nothing
End Sub
' CRIAR TABELA ACCESS
Sub CreateAccessTable(strDBPath As String)
Dim catDB As ADOX.Catalog
Dim tblNew As ADOX.Table
Set catDB = New ADOX.Catalog
' Open the Catalog object.
catDB.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strDBPath
Set tblNew = New ADOX.Table
' Create a new Table object.
With tblNew
.Name = "Contacts"
' Create fields and append them to the Columns
' collection of the new Table object.
With .Columns
.Append "FirstName", adVarWChar
.Append "LastName", adVarWChar
.Append "Phone", adVarWChar
.Append "Notes", adLongVarWChar
End With
End With
' Create the new table by adding the Table object
' to the Tables collection of the database.
catDB.Tables.Append tblNew
Set catDB = Nothing
End Sub
' CRIAR CAMPO AUTONUMERACAO
Sub CreateAutoNumberField(strDBPath As String)
Dim catDB As ADOX.Catalog
Dim tbl As ADOX.Table
Set catDB = New ADOX.Catalog
' Open the Catalog object.
catDB.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strDBPath
Set tbl = New ADOX.Table
With tbl
.Name = "ContactsWithID"
Set .ParentCatalog = catDB
' Create fields and append them to the
' Columns collection of the new Table object.
With .Columns
.Append "ContactId", adInteger
' Make the ContactId field auto-incrementing.
.Item("ContactId").Properties("AutoIncrement") = True
.Append "CustomerID", adVarWChar
.Append "FirstName", adVarWChar
.Append "LastName", adVarWChar
.Append "Phone", adVarWChar, 20
.Append "Notes", adLongVarWChar
End With
End With
' Create the new table by adding the Table object
' to the Tables collection of the database
catDB.Tables.Append tbl
Set catDB = Nothing
End Sub
' CRIAR TABELA COM UMA REGRA DE VALIDACAO
Sub CreateTableWithValidationRule(strDBPath As String)
Dim catDB As ADOX.Catalog
Dim tblNew As ADOX.Table
Set catDB = New ADOX.Catalog
' Open the Catalog object.
catDB.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strDBPath
Set tblNew = New ADOX.Table
' Create a new Table object.
With tblNew
.Name = "ContactsWithRule"
' Create fields and append them to the
' Columns collection of the new Table object.
With .Columns
.Append "FirstName", adVarWChar
.Append "LastName", adVarWChar
.Append "Phone", adVarWChar
.Append "FirstContact", adDate
.Append "LastContact", adDate
.Append "Notes", adLongVarWChar
End With
' Create the new table by adding the Table object
' to the Tables collection of the database.
catDB.Tables.Append tblNew
' Set a validation rule and text for the new table.
.Properties("Jet OLEDB:Table Validation Rule") = _
"LastContact >= FirstContact"
.Properties("Jet OLEDB:Table Validation Text") = _
"LastContact must be greater than or equal to FirstContact"
End With
Set catDB = Nothing
End Sub
' LIGAR TABELA EXTERNA
Sub CreateLinkedExternalTable(strTargetDB As String, _
strProviderString As String, _
strSourceTbl As String, _
strLinkTblName As String)
Dim catDB As ADOX.Catalog
Dim tblLink As ADOX.Table
Set catDB = New ADOX.Catalog
' Open a Catalog object on the database
' in which to create the link.
catDB.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strTargetDB
Set tblLink = New ADOX.Table
With tblLink
' Name the new table and set its ParentCatalog
' property to the open Catalog to allow access
' to the Properties collection.
.Name = strLinkTblName
Set .ParentCatalog = catDB
' Set the properties to create the link.
.Properties("Jet OLEDB:Create Link") = True
.Properties("Jet OLEDB:Link Provider String") = strProviderString
.Properties("Jet OLEDB:Remote Table Name") = strSourceTbl
End With
' Create the new linked table by adding the
' Table object to the Tables collection.
catDB.Tables.Append tblLink
Set catDB = Nothing
End Sub
' REFRESCAR AS LIGAÇÕES DAS TABELAS
Sub RefreshLinks(strDBLinkFrom As String, _
strDBLinkSource As String)
Dim catDB As ADOX.Catalog
Dim tblLink As ADOX.Table
Set catDB = New ADOX.Catalog
' Open a Catalog object on the database in which to refresh links.
catDB.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strDBLinkFrom
For Each tblLink In catDB.Tables
' Check to make sure table is a linked table.
If tblLink.Type = "LINK" Then
tblLink.Properties("Jet OLEDB:Link Datasource") = strDBLinkSource
End If
Next
Set catDB = Nothing
End Sub
'CRIAR UM INDICE
Sub CreateIndex(strDBPath As String, _
strTblToIdx As String, _
strIdxName As String, _
strIdxField As String, _
lngIndexNulls As ADOX.AllowNullsEnum, _
lngSortOrder As ADOX.SortOrderEnum)
Dim catDB As ADOX.Catalog
Dim tbl As ADOX.Table
Dim idx As ADOX.Index
Set catDB = New ADOX.Catalog
' Open a Catalog object on the database in which to create the index.
catDB.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strDBPath
Set tbl = New ADOX.Table
Set tbl = catDB.Tables(strTblToIdx)
' Create Index object and append table columns to it.
Set idx = New ADOX.Index
With idx
.Name = strIdxName
.IndexNulls = lngIndexNulls
.Columns.Append strIdxField
.Columns(strIdxField).SortOrder = lngSortOrder
End With
' Append the Index object to the Indexes
' collection of the Table object.
tbl.Indexes.Append idx
Set catDB = Nothing
End Sub
'CRIAR UMA RELAÇÃO
Sub CreateRelationship(strDBPath As String, _
strForeignTbl As String, _
strRelName As String, _
strFTKey As String, _
strRelatedTbl As String, _
strRTKey As String)
Dim catDB As ADOX.Catalog
Dim tbl As ADOX.Table
Dim key As ADOX.key
' Note that VB "enforces" the lowercasing of
' "key" in ADOX.key.
Set catDB = New ADOX.Catalog
' Open the Catalog object.
catDB.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source =" & strDBPath
Set key = New ADOX.key
' Create the foreign key to define the relationship.
With key
' Specify name for the relationship in the Keys collection.
.Name = strRelName
' Specify the related table's name.
.RelatedTable = strRelatedTbl
.Type = adKeyForeign
' Add the foreign key field to the Columns collection.
.Columns.Append strFTKey
' Specify the field the foreign key is related to.
.Columns(strFTKey).RelatedColumn = strRTKey
End With
Set tbl = New ADOX.Table
' Open the table and add the foreign key.
Set tbl = catDB.Tables(strForeignTbl)
tbl.Keys.Append key
Set catDB = Nothing
End Sub
' CRIAR UMA QUERY
Sub CreateQuery(strDBPath As String, _
strSQL As String, _
strQryName As String)
' Note: Queries that are created or modified using ADOX aren't visible
' in the Access database window.
Dim catDB As ADOX.Catalog
Dim cmd As ADODB.Command
Set catDB = New ADOX.Catalog
' Open the Catalog object.
catDB.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strDBPath
Set cmd = New ADODB.Command
' Define a Command object to contain the query's SQL
' statement, and then save it to the database's
' Views collection. strSQL must contain only a
' SELECT statement.
cmd.CommandText = strSQL
catDB.Views.Append strQryName, cmd
Set catDB = Nothing
End Sub
' MODIFICAR UMA QUERY
Sub ModifyQuery(strDBPath As String, _
strQryName As String, _
strSQL As String)
' Note: Queries that are created or modified using ADOX aren't visible
' in the Access database window. For more information, see ADOCreateQueries.doc
' in the Appendixes folder on the companion CD-ROM.
Dim catDB As ADOX.Catalog
Dim cmd As ADODB.Command
Set catDB = New ADOX.Catalog
' Open the Catalog object.
catDB.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strDBPath
Set cmd = New ADODB.Command
' Get the query from the Procedures collection.
Set cmd = catDB.Procedures(strQryName).Command
' Update the query's SQL statement.
cmd.CommandText = strSQL
'Save the updated query.
Set catDB.Procedures(strQryName).Command = cmd
Set catDB = Nothing
End Sub
' CORRER UM COMANDO SQL
Sub RunSQLCommand(strDBPath As String, _
strSQL As String)
Dim cmd As ADODB.Command
Dim strConnect As String
strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath
Set cmd = New ADODB.Command
With cmd
.CommandText = strSQL
.ActiveConnection = strConnect
.Execute
End With
Set cmd = Nothing
End Sub
Sub RunSQLConnection(strDBPath As String, _
strSQL As String)
Dim cnn As ADODB.Connection
Dim strConnect As String
strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strDBPath
Set cnn = New ADODB.Connection
With cnn
.Open strConnect
.Execute strSQL
.Close
End With
Set cnn = Nothing
End Sub
|
|
|
|
|
