Dim objconnection ' Connection object instance
Dim objRecordSet ' Recordset object instance
Dim objcommand ' Command object instance
Dim strconnectionstring ' connection string
' ********************************************************************
' function Description: Connecting to the database;
' Parameter description: (1) Strdbtype (database type: e.g. oracel;db2;sql;access)
' (2) Strdbalias (database alias)
' (3) struid (username)
' (4) strpwd (password)
' (5) StrIP (Database IP address: SQL SERVER only use)
' (6) strlocalhostname (Local host name: SQL SERVER only use)
' (7) strDataSource (data source: access only use; d:\yysc.mdb)
' Return Result: none
' Call Method: Connectdatabase (Strdbtype, Strdbalias, Struid, Strpwd, StrIP, Strlocalhostname, strDataSource)
' ********************************************************************
Sub connectdatabase (Strdbtype, Strdbalias, Struid, Strpwd, StrIP, Strlocalhostname, strDataSource)
Set objconnection = CreateObject ("ADODB. CONNECTION "' 1-Create an instance of a CONNECTION object
Select Case UCase (Trim (Strdbtype))
Case "ORACLE"
strConnectionString = "Driver={microsoft ODBC for Oracle}; Server= "& Strdbalias &"; Uid= "_
& Struid & "; Pwd= "& Strpwd &"; ' 2-Establish a connection string
Objconnection.open strConnectionString ' 3-Establish a connection to a database with the Open method
Case "DB2"
strConnectionString = "DRIVER={IBM DB2 ODBC Driver};D balias=" & 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 "entered a database type format incorrectly" & VBCRLF & Supported database type format: Oracle;db2;sql;access;excel "
End Select
If (objconnection.state = 0) Then
MsgBox failed to connect to the database. "
End If
End Sub
' ********************************************************************
' Function Description: Query the database (query single column);
' Parameter description: (1) strsql:sql statement
' (2) strfieldname: Field name
' (3) Str_array_queryresult: array name (used to return a single-column query result)
' Return result: intarraylength: Query database returned rows of records
' Str_array_queryresult: Array name (used to return a single-column query result)
' Call method: Intarraylength = QueryDatabase (strSQL, strFieldName, Str_array_queryresult)
' ********************************************************************
Function querydatabase (strSQL, strFieldName, Str_array_queryresult)
Dim intarraylength ' array length
Dim I
i = 0
Str_array_queryresult = Array () "Reinitialize" arrays as an empty array
Set objRecordSet = CreateObject ("ADODB. Recordset "' 4-Create a Recordset object instance
Set objcommand = CreateObject ("Adodb.command" ' 5-Create COMMAND object instance
objCommand.ActiveConnection = objconnection
Objcommand.commandtext = strSQL
Objrecordset.cursorlocation = 3
Objrecordset.open Objcommand ' 6-executes the SQL statement and saves the results in the Recordset object instance
Intarraylength = Objrecordset.recordcount ' The number of rows in the query result as the length of the array
If intarraylength > 0 Then
ReDim Str_array_queryresult (intArrayLength-1)
Do as not objrecordset.eof ' assigns the column value of a database query to an array
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
' ********************************************************************
' Function Description: Update database, including INSERT, DELETE, and update operations
' Parameter description: (1) strsql:sql statement
' Return Result: none
' Call Method: 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
' ********************************************************************
' Function Description: Returns the length of the column that matches the query result
' Parameter description: (1) strsql:sql statement
' Return result: Returns the length of the column that matches the query result
' Call method: MaxLength = Getlenoffield (strSQL)
' ********************************************************************
Function Getlenoffield (strSQL)
' If the SQL statement is empty, the column length returned by default is 0, ending the function; otherwise the actual length of the column is returned
If strSQL = "" Then
Getlenoffield = 0
Exit Function
Else
Set objRecordSet = CreateObject ("ADODB. Recordset ") ' 4-Create a Recordset object instance
Set objcommand = CreateObject ("Adodb.command") ' 5-Create COMMAND object instance
objCommand.ActiveConnection = objconnection
Objcommand.commandtext = strSQL
Objrecordset.cursorlocation = 3
Objrecordset.open Objcommand ' 6-executes the SQL statement and saves the results in the Recordset object instance
Getlenoffield = Objrecordset.recordcount ' Returns the length of the column that matches the query result
Set objcommand = Nothing
Set objRecordSet = Nothing
End If
End Function
' ********************************************************************
' Function Description: Close the database connection;
' Parameter description: None
' Return Result: none
' Call Method: CloseDatabase ()
' ********************************************************************
Sub CloseDatabase ()
Objrecordset.close
Objconnection.close
Set objcommand = Nothing
Set objRecordSet = Nothing
Set objconnection = Nothing
End Sub