| {\rtf1\ansi\ansicpg1252\deff0\deflang1044{\fonttbl{\f0\fnil\fcharset0 MS Sans Serif;}} {\colortbl ;\red0\green0\blue255;} \viewkind4\uc1\pard\f0\fs17 Description:Need to do any oracle/ADO work? I wrote these to help me along in my projects. I hope you find them useful too. \par \par \cf1 Function ConnectToOracle(ByVal sWorld As String, ByVal sUID As String, ByVal sPWD As String) As String \par \cf0 'Connection to Oracle using Oracle OLE driver \par On Error Goto Ouch \par P11D_DB.Open "Provider=OraOLEDB.Oracle;data source=" & _ \par \tab sWorld & ".World;User id=" & sUID & ";password=" & sPWD & ";" \par ConnectToOracle = "" \par Exit Function \par Ouch: \par ConnectToOracle = Err.Description & " (" & Err.Number & ")" \par \cf1 End Function\cf0 \par \par \par \cf1 Sub CloseConnectionToOracle() \par \cf0 ' Close Connection to Oracle \par 'on error resume next \par If P11D_DB.State <> 0 Then \par P11D_DB.Close \par End If \par \cf1 End Sub \par \cf0 \par \par \cf1 Function OracleDate(dIn As Date) As String \par \cf0 'Insert/Update/Retrieve an oracle date in it's proper format \par 'sSQl=".... where DATE_COL = " & oracledate(VBDateField) & "....." \par OracleDate = "to_date('" & Format(dIn, "dd/mm/yyyy") & "','dd/mm/yyyy')" \par \cf1 End Function\cf0 \par \par \par \cf1 Public Function GetColumnData() As String()\cf0 \par 'Return a column of data via an array \par Dim sColRetr() As String \par Dim rsColRetr As New ADODB.Recordset \par Dim sSQL As String \par Dim x As Integer \par sSQL = "select COLUMN_NAME from TABLE" \par rsColRetr.Open sSQL, ADO_Connection, adOpenStatic, adLockReadOnly \par ReDim sColRetr(rsColRetr.RecordCount) \par x = 0 \par \par While Not rsColRetr.EOF \par sColRetr(x) = rsColRetr!band_description \par rsColRetr.MoveNext \par x = x + 1 \par Wend \par rsColRetr.Close \par Set rsColRetr = Nothing \par ReDim preserve sColRetr(ubound(sColRetr)-1) \par GetColumnData = sColRetr \par \cf1 End Function\cf0 \par \par \par \cf1 Sub OracleCommit()\cf0 \par 'Commit inserts and updates \par 'on error resume next \par Dim rsCMD As New ADODB.Command \par \par With rsCMD \par .ActiveConnection = P11D_DB \par .CommandText = "commit" \par .Execute \par End With \par Set rsCMD = Nothing \par \cf1 End Sub\cf0 \par \par \par \cf1 Function GetDescForTable(ByVal sTable As String, ByVal sOwner As String) As String()\cf0 \par ' Get the Column names for a table \par Dim TD() As String \par Dim rsD As New ADODB.Recordset \par Dim sSQL As String \par sSQL = "select column_name " & _ \par "from dba_tab_columns where owner = '" & sOwner & "' " & _ \par "and table_name = '" & sTable & "'" \par rsD.Open sSQL, ADO_Connection, adOpenStatic, adLockReadOnly \par ReDim TD(0) \par \par While Not rsD.EOF \par ReDim Preserve TD(UBound(TD) + 1) \par TD(UBound(TD) - 1) = rsD!column_name \par rsD.MoveNext \par Wend \par rsD.Close \par ReDim Preserve TD(UBound(TD) - 1) \par GetDescForTable = TD \par \cf1 End Function\cf0 \par \par \par \cf1 Function GetTables(ByVal sOwner as string) As String()\cf0 \par 'Get the Table names for an owner \par Dim TL() As String \par Dim rs As New ADODB.Recordset \par Dim sSQL As String \par sSQL = "select table_name from sys.all_tables where owner = '" & sOwner & "'" \par rs.Open sSQL, ADO_Connection, adOpenStatic, adLockReadOnly \par ReDim TL(0) \par \par While Not rs.EOF \par ReDim Preserve TL(UBound(TL) + 1) \par TL(UBound(TL) - 1) = rs!table_name \par rs.MoveNext \par Wend \par rs.Close \par Set rs = Nothing \par ReDim Preserve TL(UBound(TL) - 1) \par GetTables = TL \par \cf1 End Function\cf0 \par \par \par \cf1 Function HandleQuotes(ByVal sIn As String) As String\cf0 \par ' take care of single quotes on record update/retrieval to handle data like Mike O'Sullivan \par HandleQuotes = Replace(sIn, "'", "''") \par \cf1 End Function\cf0 \par \par \par \cf1 Function ScrNull(sIn As Variant) As String\cf0 \par \par 'when referencing a recordset field wrap it with this function to return a "" to a string where the column data \par 'held a null, eg; sString=ScrNull(rsCol!Column_Data \par \par If IsNull(sIn) Then \par ScrNull = "" \par Else \par ScrNull = sIn \par End If \par \cf1 End Function\cf0 \par \par \par \cf1 Function GetTotal() As Double\cf0 \par 'Get the total of a column of data \par Dim rsFT As New ADODB.Recordset \par Dim sSQL As String \par sSQL = "select sum(COLUMN_DATA) as FC_Total from TABLE where ...condition..." \par rsFT.Open sSQL, P11D_DB, adOpenStatic, adLockReadOnly \par \par \par If rsFT.EOF Then \par GetTotal = 0 \par ElseIf IsNull(rsFT!fc_total) Then \par GetTotal = 0 \par Else \par GetTotal = CDbl(rsFT!fc_total) \par End If \par rsFT.Close \par Set rsFT = Nothing \par \cf1 End Function\cf0 \par } |
Very useful Oracle/VB ADO samples |
India web developer web development India | India web development company India ecommerce web developer