MS Excel可以通过OO4O (oracle objects for OLE) 来访问Oracle.
如果出现找不到对象,或者无法创建对象之类的错误,请先安装OO4O,Oracle网站上可以找到,Oracle8的Client是默认安装的。但是Oracle9没有,所以需要自行下载安装。范例如下:
========================
Sheet1 为查询条件页
Sheet2为结果页
Sheet1中查询条件的第一行表头必须与数据库的字段名称一样,下面同列可以放多个条件模糊查询
如果要新增查询条件,只需要在sheet1第一行增加表头,在表头下面跟随查询条件即可,查询条件可以为空,但是不可以跳行
Sheet2中显示查询,目前是自动显示所有字段,如果不需要则要去代码中修改,将select * from 改成 select 字段1,字段2…from 即可
进入宏(macro)编辑模式 , 修改数据库连接(Tnsnames.ora中配置的名称)以及用户名密码
========================
- Sub Query()
- 'Original Coder:Ben Chan(go2cpp#gmail.com)
- 'Create Date 2008/12/23
- 'if you made a big change, please log it, I would like to receive your changes or suggestions.
- Sheet2.Activate
- Cells.Select
- Cells.ClearContents
- Call ConnectDB
- End Sub
- Sub ConnectDB()
- Dim objOraSession, objOraDb
- Dim strDbUser, strDbPwd, strDbConn
- On Error Resume Next
- strDbUser = "userid" 'UserId
- strDbPwd = "password" 'PSW
- strDbConn = "hrms" 'Connection
- Set objOraSession = CreateObject("OracleInProcServer.XOraSession")
- Set objOraDb = objOraSession.OpenDatabase(strDbConn, strDbUser & "/" & strDbPwd, 0)
- If Err.Number > 0 Then
- MsgBox (Err.HelpContext & Err.Description & Err.HelpFile & Err.LastDllError & Err.Number & Err.Source)
- End If
- Dim strSql
- strSql = getSql()
- Set objRs = objOraDb.DbCreateDynaset(strSql, 0)
- 'if no data found then exit
- If objRs.RecordCount = 0 Then
- MsgBox ("No data found!" & Err.Description)
- GoTo LabelEnd
- End If
- 'display the query result
- Sheet2.Activate
- If objRs.RecordCount > 0 Then
- objRs.MoveFirst
- MsgBox objRs("name")
- For x = 0 To objRs.Fields.Count - 1
- Sheet2.Cells(1, x + 1) = objRs.Fields(x).Name
- Sheet2.Cells(1, x + 1).Format = Bold
- Next
- For y = 0 To objRs.RecordCount - 1
- For x = 0 To objRs.Fields.Count - 1
- Sheet2.Cells(y + 2, x + 1) = objRs.Fields(x).Value
- Next
- objRs.MoveNext
- Next
- End If
- LabelEnd:
- Set objOraDb = Nothing
- Set objOraSession = Nothing
- End Sub
- Function getSql() As String
- Dim strSql, strTemp As String
- Dim nCol, nRow As Integer
- nCol = 0 'the number of query condition, and should start from top left of the sheet1
- While (Sheet1.Cells(1, nCol + 1).Value <> "")
- nCol = nCol + 1
- Wend
- If nCol = 0 Then
- getSql = ""
- Exit Function
- End If
- 'strSql = "select EMPLID,NAME,NAME_A,PLANT_ID_A,EMAIL_ADDRESS_A,DEPTID,DEPT_DESCR_A,UPPER_DEPTID_A,ORIG_HIRE_DT,ADULT_INDI_A,COMPANY,BATCH_NUMBER_A,PHONE_A,EMPL_CATEGORY_A,SUPERVISOR_ID,OFFICER_LEVEL_A,KTP#_IDN from PS_SUB_WZS_AT_VW_A where 1=1 "
- strSql = "select * from PS_SUB_WZS_AT_VW_A where 1=1 "
- strTemp = ""
- For i = 1 To nCol 'collumn
- nRow = 2
- strTemp = ""
- Do
- If (Sheet1.Cells(nRow, i).Value <> "" And nRow = 2) Then
- strTemp = " and (" & Sheet1.Cells(1, i).Value & " like '%" & Sheet1.Cells(nRow, i).Value & "%' "
- ElseIf (Sheet1.Cells(nRow, i).Value <> "") Then
- strTemp = strTemp & " or " & Sheet1.Cells(1, i).Value & " like '%" & Sheet1.Cells(nRow, i).Value & "%'"
- ElseIf (Sheet1.Cells(nRow, i).Value = "" And nRow <> 2) Then
- ' strTemp = strTemp & " aaa) "
- ' ElseIf (Sheet1.Cells(nRow, i).Value = "") Then
- End If
- nRow = nRow + 1
- Loop Until (Sheet1.Cells(nRow, i).Value = "")
- If (strTemp <> "") Then
- strSql = strSql & strTemp
- strSql = strSql & ")"
- End If
- Next
- getSql = strSql
- End Function