原文地址:
http://bbs.51testing.com/viewthread.php?tid=118028&highlight=
代码如下:
' DATABASE公用函数 ''########################################################################################################### ''CONNECTION对象实例 Dim objRecordSet ''命令对象实例 Dim strConnectionString '' ******************************************************************** '' 参数说明:(1)strDBType(数据库类型:如ORACEL;DB2;SQL;ACCESS) '' (3)strUID(用户名) '' (5)strIP(数据库IP地址:仅SQL SERVER 使用) '' (7)strDataSource(数据源:仅ACCESS使用;如d:\yysc.mdb) '' 调用方法: ConnectDatabase(strDBType, strDBAlias, strUID, strPWD, strIP, strLocalHostName, strDataSource) '"ADODB.CONNECTION"'1 - 建立CONNECTION对象的实例 Select Case UCase(Trim(strDBType)) Case "ORACLE" strConnectionString = "Driver={Microsoft ODBC for Oracle};Server=" & strDBAlias & ";Uid="_ & strUID & ";Pwd=" & strPWD & ";" ''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 OLEDB:Database 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 '' 函数说明:查询数据库(查询单列); '' (2)strFieldName:字段名 '' 返回结果: intArrayLength:查询数据库返回的记录行数 '' 调用方法: intArrayLength = QueryDatabase(strSql, strFieldName, str_Array_QueryResult) ''数组长度 Dim i i = 0 str_Array_QueryResult = Array() '"ADODB.RECORDSET"'4 - 建立RECORDSET对象实例 Set objCommand = CreateObject("ADODB.COMMAND") ''6 - 执行SQL语句,将结果保存在RECORDSET对象实例中 intArrayLength = objRecordSet.RecordCount ''将数据库查询的列值赋值给数组 str_Array_QueryResult(i) = objRecordSet(strFieldName) '' Else ''str_Array_QueryResult(0) = "" End If QueryDatabase = intArrayLength End Function '' 函数说明:更新数据库;包括INSERT、DELETE 和 UPDATE操作 '' 返回结果:无 '' ******************************************************************** 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 '' For Each objField In objRecordSet.Fields '": "" "' Next '' Debug.WriteLine '' ******************************************************************** '' 参数说明:(1)strSql:SQL语句 '' 调用方法: MaxLength = GetLenOfField(strSql) ''如果SQL语句为空,则默认返回的列长度为0,结束函数;否则返回列的实际长度 If strSql = "" Then GetLenOfField = 0 Exit Function Else Set objRecordSet = CreateObject("ADODB.RECORDSET") '"ADODB.COMMAND"'5 - 建立COMMAND对象实例 objCommand.ActiveConnection = objConnection objCommand.CommandText = strSql objRecordSet.CursorLocation = 3 objRecordSet.Open objCommand ''返回符合查询结果的列的长度 Set objCommand = Nothing Set objRecordSet = Nothing End If End Function '' 函数说明:关闭数据库连接; '' 返回结果:无 '
End Sub
本文转自hcy's workbench博客园博客,原文链接:http://www.cnblogs.com/alterhu/archive/2012/03/25/2417060.html,如需转载请自行联系原作者。