第16章 处理数据库

16.1 数据库基础

 

16.2 提高你的技巧

16.3 原始Excel数据库的集成

16.4 ADO

16.4.1 建立一个连接

 

代码

' 代码清单16.1：一个简单的连接例子
Sub  MakeConnectionExample()
     Dim  conn  As  ADODB.Connection
     On   Error   GoTo  ErrHandler
    
     Set  conn  =   New  ADODB.Connection
    conn.Provider  =   " Microsoft.Jet.OLEDB.4.0; "
    conn.ConnectionString  =   " Data Source=F:\DataBase\cslBasicData.mdb "
    conn.Open
    
     If  conn.State  =  adStateOpen  Then
         MsgBox   " connected! " , vbOKOnly
        conn.Close
     Else
         MsgBox   " not connected! " , vbOKCancel
     End   If
    
     Set  conn  =   Nothing
     Exit Sub
    
ErrHandler:
     MsgBox   " could not connect to database. "   &  Err.Description, vbOKOnly
    
End Sub

 

16.4.2 准备、设置、查询

代码清单16.2：使用RECORDSET执行并显示一个查询

 

 

代码

' 代码清单16.2：使用RECORDSET执行并显示一个查询
Sub  RecordsetExample()
     Dim  rst  As  ADODB.Recordset
     Dim  sConn  As   String
     Dim  sSQL  As   String
     Dim  rg  As  Range
    
     On   Error   GoTo  ErrHandler
    
     Set  rg  =  ThisWorkbook.Worksheets( 1 ).Range( " A1 " )
    
     ' Create a new recordset object
     Set  rst  =   New  ADODB.Recordset
    
     ' Connection details - this is the kind of thing
     ' that you can use the settings class for
    sConn  =   " Provider=Microsoft.Jet.OLEDB.4.0;Data Source=F:\DataBase\cslBasicData.mdb "
    
     ' sql statement to retrieve list of employees
    sSQL  =   " SELECT LastName, FirstName, Title FROM employees "
    
     ' Open the recordset
    rst.Open sSQL, sConn
    
     ' copy recordset to the range
    rg.CopyFromRecordset rst
    
     ' adjust column sizes
    rg.CurrentRegion.Columns.AutoFit
    
     ' close the recordset
    rst.Close
    
     ' clean up
     Set  rst  =   Nothing
     Set  rg  =   Nothing
     Exit Sub
    
ErrHandler:
     MsgBox   " Sorry, an error occured.  "   &  Err.Description, vbOKOnly
End Sub

 

代码清单16.3：循环一个记录集

 

代码

' 代码清单16.3：循环一个记录集
Sub  LoopThroughRecordset(rst  As  ADODB.Recordset, rg  As  Range)
     Dim  nColumnOffset  As   Integer
     Dim  fld  As  ADODB.Field
    
     ' Use With...End With on rst to
     ' save typing & increase performance
     ' Downside - harder to read.
    
     With  rst
         ' Loop until we hit the end of the
         ' recordset
         Do   Until  .EOF
             ' Loop through each field and retrieve it's value
            nColumnOffset  =   0
             For   Each  fld  In  .Fields
                rg.Offset( 0 , nColumnOffset).Value  =  fld.Value
                nColumnOffset  =  nColumnOffset  +   1
             Next
            
             ' move down one row on the worksheet
             Set  rg  =  rg.Offset( 1 ,  0 )
            
             ' move to the next record
            .MoveNext
         Loop
        
     End   With
    
     ' clean up.
     Set  fld  =   Nothing
    
End Sub

 

 

16.4.3 不仅仅是取回数据

代码清单16.4：执行查询动作

 

代码

' 代码清单16 0.4: 执行查询动作
Sub  TestActionQuery()
     Dim  conn  As  ADODB.Connection
     Dim  lRecordsAffected  As   Long
     Dim  sSql  As   String
    
     On   Error   GoTo  ErrHandler
    
     Set  conn  =   New  ADODB.Connection
    
    conn.ConnectionString  =   " Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\Northwind.mdb "
    conn.Open
    
     If  conn.State  =  adStateOpen  Then
    
         ' add a new category
        sSql  =   " INSERT INTO Categories([CategoryName],[Description]) "   &  _
             " Values('Jerky','Beef jerky, turkey jerky, and other tasty jerkies'); "
        
        lRecordsAffected  =  ActionQuery(conn, sSql)
         MsgBox   " added "   &  lRecordsAffected  &   "  records. " , vbOKOnly
        
         ' edit an existing category
        sSql  =   " UPDATE Categories SET [Description] =  "   &  _
             " 'Prepared meats except for jerky' "   &  _
             " Where [Categories]='Meat/Poultry'; "
        lRecordsAffected  =  ActionQuery(conn, sSql)
         MsgBox   " Updated  "   &  lRecordsAffected  &   "  records. " , vbOKOnly        
        conn.Close
     End   If     
     Set  conn  =   Nothing
     Exit Sub
ErrHandler:
     MsgBox   " Could not connect to database.  "   &  Err.Description, vbOKOnly    
End Sub

' / returns number of records affected
Function  ActionQuery(conn  As  ADODB.Connection, sSql  As   String )  As   Long
     Dim  lRecordsAffected  As   Long
     Dim  cmd  As  ADODB.Command
    
     On   Error   GoTo  ErrHandler    
    lRecordsAffected  =   0     
     Set  cmd  =   New  ADODB.Command
     With  cmd
        .ActiveConnection  =  conn
        .CommandText  =  sSql
        .CommandType  =  adCmdText
        .Execute lRecordsAffected
     End   With
    
     ' clean up.
     Set  cmd  =   Nothing     
ExitPoint:
    ActionQuery  =  lRecordsAffected
     Exit Function
ErrHandler:
    Debug.Print  " ActionQuery error:  "   &  Err.Description
     Resume  ExitPoint
End Function

 

 

16.5 我喜欢款待

代码清单16.5：一个使用Analysis Services数据的基本例子

 

代码

Const  msCONNECTION  =   " Data Source=localhost;Initial Catalog=FoodMart 2000;Provider=msolap; "

Sub  BasicQueryExampleI()
     Dim  rst  As  ADODB.Recordset
     Dim  sMDX  As   String
     Dim  ws  As  Worksheet
    
     On   Error   GoTo  ErrHandler    
     Set  ws  =  ThisWorkbook.Worksheets( 2 )    
     ' an analysis services query
    sMDX  =   " SELECT {[Measures].[Units Shipped],[Measures].[Units Ordered]} on columns,  "   &  _
    　　 " NON EMPTY [Store].[Store City].members on rows  "   &  _
    　　 " from Warehouse "
    
     ' You can use adodb.recordset or adomd.cellset
     Set  rst  =   New  ADODB.Recordset
    
     ' open the recordset - implicit connection object creation
    rst.Open sMDX, msCONNECTION
    
     ' use of the recordset object is handy because
     ' it allows use of the CopyFromRecordset method
    ws.Cells( 1 ,  1 ).CopyFromRecordset rst
    rst.Close    
ExitPoint:
     Set  rst  =   Nothing
     Set  ws  =   Nothing
     Exit Sub
ErrHandler:
     MsgBox   " an error occured -  "   &  Err.Description, vbOKOnly
     Resume  ExitPoint
End Sub

 代码清单16.6: 一个使用ADOMD的基本范例

 

代码

' 代码清单16.6: 一个使用ADOMD的基本范例
Const  msCONNECTION  =   " Data Source=localhost;Initial Catalog=FoodMart 2000;Provider=msolap; "

Sub  BasicQueryExampleII()
     Dim  cst  As  ADOMD.Cellset
     Dim  cat  As  ADOMD.Catalog
    
     Dim  sMDX  As   String
     Dim  ws  As  Worksheet
    
     On   Error   GoTo  ErrHandler
    
     Set  ws  =  ThisWorkbook.Worksheets( 2 )
    
     ' an analysis services query
    sMDX  =   " SELECT {[Measures].[Units Shipped],[Measures].[Units Ordered]} on columns,  "   &  _
         " NON EMPTY [Store].[Store City].members on rows  "   &  _
         " from Warehouse "
    
     ' unfortunately you need to explicitly create
     ' this object for the Cellset object (a Cellset
     ' object can't implicitly create a connection
     ' like a recordset object can)
     Set  cat  =   New  ADOMD.catalog
    cat.ActiveConnection  =  msCONNECTION
    
     ' create new Cellset and query away
     Set  cst  =   New  ADOMD.Cellset
    cst.Open sMDX, cat.ActiveConnection
    
     ' call procedure to display the data
    DisplayCellset cst, ws.Cells( 1 ,  1 )    
    cst.Close    
ExitPoint:
     Set  cat  =   Nothing
     Set  cst  =   Nothing
     Set  ws  =   Nothing
     Exit Sub
ErrHandler:
     MsgBox   " an error occured -  "   &  Err.Description, vbOKOnly
     Resume  ExitPoint
End Sub

Sub  DisplayCellset(cst  As  ADOMD.Cellset, rgTopLeft  As  Range)
     Dim  nRow  As   Integer
     Dim  nRowDimensionCount  As   Integer
     Dim  nColumnMember  As   Integer
     Dim  nRowDimension  As   Integer
     Dim  nRowMember  As   Integer
    
     On   Error   GoTo  ErrHandler
    
    nRowDimensionCount  =  cst.Axes( 1 ).DimensionCount
    
     ' Loop through the rows contained in the Cellset
     For  nRow  =   0   To  cst.Axes( 1 ).positions.Count  -   1
         ' display labels for each row item
         For  nRowDimension  =   0   To  nRowDimensionCount  -   1
            rgTopLeft.Offset(nRow, nRowDimension).Value  =  _
                cst.Axes( 1 ).positions(nRow).Members(nRowDimension).Caption
         Next
            
         ' Display values at each dimension intersection
         For  nColumnMember  =   0   To  cst.Axes( 0 ).Posions.Count  -   1
            rgTopLeft.Offset(nRow, nRowDimensionCount  +  nColumnMember).Value  =  _
                cst.Item(nColumnMember, nRow).FormattedValue
         Next
     Next         
ExitPoint:
     Exit Sub
ErrHandler:
    Debug.Print  " DisplayCellset Error:  "   &  Err.Description, vbOKOnly
     Resume  ExitPoint    
End Sub

 

 

 

转载于:https://www.cnblogs.com/csl-office-vb-sql-net/archive/2010/01/21/1653247.html