VBS串連資料庫代碼

Dim objConnection                          'CONNECTION對象執行個體
Dim objRecordSet                                   'RECORDSET對象執行個體       
Dim objCommand                                '命令對象執行個體
Dim strConnectionString                        '連接字串

' ********************************************************************
' 函數說明：串連資料庫;
' 參數說明：(1)strDBType（資料庫類型：如ORACEL；DB2；SQL；ACCESS）
'           (2)strDBAlias（資料庫別名）
'           (3)strUID（使用者名稱）
'           (4)strPWD（密碼）
'           (5)strIP（資料庫IP地址：僅SQL SERVER 使用）
'           (6)strLocalHostName（本地主機名稱：僅SQL SERVER 使用）
'           (7)strDataSource（資料來源：僅ACCESS使用；如d:\yysc.mdb）
' 返回結果：無
' 調用方法: ConnectDatabase(strDBType, strDBAlias, strUID, strPWD, strIP, strLocalHostName, strDataSource)
' ********************************************************************
Sub ConnectDatabase(strDBType, strDBAlias, strUID, strPWD, strIP, strLocalHostName, strDataSource)
    Set objConnection = CreateObject("ADODB.CONNECTION"                '1 - 建立CONNECTION對象的執行個體
   
    Select Case UCase(Trim(strDBType))
        Case "ORACLE"
            strConnectionString = "Driver={Microsoft ODBC for Oracle};Server=" & strDBAlias & ";Uid="_
                & strUID & ";Pwd=" & strPWD & ";"                                '2 - 建立連接字串
            objConnection.Open strConnectionString                                '3 - 用Open 方法建立與資料庫連接
        Case "DB2"
            strConnectionString = "Driver={IBM DB2 ODBC DRIVER};DBALIAS=" & strDBAlias & ";Uid="_
                & strUID & ";Pwd=" & strPWD & ";"                               
            objConnection.Open strConnectionString                               
        Case "SQL"
             strConnectionString = "DRIVER=SQL Server; SERVER=" & strIP & "; UID=" & strUID & "; PWD="_
                 & strPWD & "; APP=Microsoft Office 2003;WSID=" & strLocalHostName & "; DATABASE=" & strDBAlias & ";"
            objConnection.Open strConnectionString                                           
        Case "ACCESS"
            strConnectionString = "provider=microsoft.jet.oledb.4.0;data source=" & strDataSource &_
                ";Jet OLEDBatabase Password=" & strPWD & ";"
            objConnection.Open strConnectionString                                                 
        Case Else
            MsgBox "輸入的資料庫類型格式有誤" & vbCrLf & "支援的資料庫類型格式：ORACLE；DB2；SQL；ACCESS；EXCEL"
    End Select
   
    If (objConnection.State = 0) Then
        MsgBox "串連資料庫失敗。"
    End If
   
End Sub

' ********************************************************************
' 函數說明：查詢資料庫（查詢單列）;
' 參數說明：  (1)strSql：SQL語句
'           (2)strFieldName：欄位名
'           (3)str_Array_QueryResult：數組名（用來返回單列查詢結果）
' 返回結果：  intArrayLength：查詢資料庫返回的記錄行數
'           str_Array_QueryResult：數組名（用來返回單列查詢結果）
' 調用方法: intArrayLength = QueryDatabase(strSql, strFieldName, str_Array_QueryResult)
' ********************************************************************
Function QueryDatabase(strSql, strFieldName, str_Array_QueryResult)
    Dim intArrayLength                                                                                     '數組長度
     Dim i
   
    i = 0  
    str_Array_QueryResult = Array()                                '重新初始化數組為一個空數組
   
    Set objRecordSet = CreateObject("ADODB.RECORDSET"                '4 - 建立RECORDSET對象執行個體
    Set objCommand = CreateObject("ADODB.COMMAND"              '5 - 建立COMMAND對象執行個體
    objCommand.ActiveConnection = objConnection
    objCommand.CommandText = strSql
        objRecordSet.CursorLocation = 3
        objRecordSet.Open objCommand                            '6 - 執行SQL語句,將結果儲存在RECORDSET對象執行個體中
   
    intArrayLength = objRecordSet.RecordCount                  '將查詢結果的行數作為數組的長度
   
    If intArrayLength > 0 Then
                ReDim str_Array_QueryResult(intArrayLength-1)
               
                Do While NOT objRecordSet.EOF                                                '將資料庫查詢的列值賦值給數組            
                    str_Array_QueryResult(i) = objRecordSet(strFieldName)
                        'Debug.WriteLine str_Array_QueryResult(i)
                        objRecordSet.MoveNext
                        i = i + 1
                Loop
'        Else
                'ReDim str_Array_QueryResult(0)      
                'str_Array_QueryResult(0) = ""    
    End If
   
    QueryDatabase = intArrayLength
End Function

' ********************************************************************
' 函數說明：更新資料庫;包括INSERT、DELETE 和 UPDATE操作
' 參數說明：(1)strSql：SQL語句
' 返回結果：無
' 調用方法: UpdateDatabase(strSql)
' ********************************************************************
Sub UpdateDatabase(strSql)
        Dim objCommand
        Dim objField       
       
        Set objCommand = CreateObject("ADODB.COMMAND")
        Set objRecordSet = CreateObject("ADODB.RECORDSET")
        objCommand.CommandText = strSql
        objCommand.ActiveConnection = objConnection
        Set objRecordSet = objCommand.Execute
       
'        Do Until objRecordSet.EOF
       
'                For Each objField In objRecordSet.Fields
'                        Debug.Write objField.Name & ": " & objField.Value & "   "
'                Next
               
'                objRecordSet.MoveNext
'                Debug.WriteLine
'        Loop       
       
        Set objCommand = Nothing
        Set objRecordSet = Nothing
               
End Sub

 

 

' ********************************************************************
' 函數說明：返回符合查詢結果的列的長度
' 參數說明：(1)strSql：SQL語句
' 返回結果：返回符合查詢結果的列的長度
' 調用方法: MaxLength = GetLenOfField(strSql)
' ********************************************************************
Function GetLenOfField(strSql)
    '如果SQL語句為空白，則預設返回的列長度為0，結束函數;否則返回列的實際長度
    If strSql = "" Then
        GetLenOfField  = 0
                Exit Function
    Else
            Set objRecordSet = CreateObject("ADODB.RECORDSET")                        '4 - 建立RECORDSET對象執行個體
            Set objCommand = CreateObject("ADODB.COMMAND")              '5 - 建立COMMAND對象執行個體
            objCommand.ActiveConnection = objConnection
            objCommand.CommandText = strSql
                objRecordSet.CursorLocation = 3
                objRecordSet.Open objCommand                                '6 - 執行SQL語句,將結果儲存在RECORDSET對象執行個體中
           
            GetLenOfField = objRecordSet.RecordCount                              '返回符合查詢結果的列的長度
       
                Set objCommand = Nothing       
                Set objRecordSet = Nothing
        End If
End Function

' ********************************************************************
' 函數說明：關閉資料庫連接;
' 參數說明：無
' 返回結果：無
' 調用方法: CloseDatabase()
' ********************************************************************
Sub CloseDatabase()
    objRecordSet.Close
    objConnection.Close
   
    Set objCommand = Nothing
    Set objRecordSet = Nothing
    Set objConnection = Nothing
End Sub