Excel访问Oracle

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中配置的名称)以及用户名密码

========================

 

1. Sub Query()
2. 'Original Coder:Ben Chan(go2cpp#gmail.com)
3. 'Create Date 2008/12/23
4. 'if you made a big change, please log it, I would like to receive your changes or suggestions.
5. Sheet2.Activate
6. Cells.Select
7. Cells.ClearContents
8. Call ConnectDB
9. End Sub
10. Sub ConnectDB()
11. Dim objOraSession, objOraDb
12. Dim strDbUser, strDbPwd, strDbConn
13.  On Error Resume Next
14.  strDbUser = "userid"       'UserId
15.  strDbPwd = "password"        'PSW
16.  strDbConn = "hrms"            'Connection
18.  Set objOraSession = CreateObject("OracleInProcServer.XOraSession")
19.  Set objOraDb = objOraSession.OpenDatabase(strDbConn, strDbUser & "/" & strDbPwd, 0)
21.  If Err.Number > 0 Then
22.  MsgBox (Err.HelpContext & Err.Description & Err.HelpFile & Err.LastDllError & Err.Number & Err.Source)
23.  End If
25.  Dim strSql
26.  strSql = getSql()
28.  Set objRs = objOraDb.DbCreateDynaset(strSql, 0)
29.   'if no data found then exit
30.  If objRs.RecordCount = 0 Then
31.   MsgBox ("No data found!" & Err.Description)
32.   GoTo LabelEnd
33.  End If
34.  'display the query result
35.   Sheet2.Activate
36.   
37.  If objRs.RecordCount > 0 Then
38.                   objRs.MoveFirst
39.                   MsgBox objRs("name")
40.                   For x = 0 To objRs.Fields.Count - 1
41.                           Sheet2.Cells(1, x + 1) = objRs.Fields(x).Name
42.                           Sheet2.Cells(1, x + 1).Format = Bold
43.                   Next
44.     
45.                   For y = 0 To objRs.RecordCount - 1
46.                           For x = 0 To objRs.Fields.Count - 1
47.                                   Sheet2.Cells(y + 2, x + 1) = objRs.Fields(x).Value
48.                           Next
49.                           objRs.MoveNext
50.                   Next
51. End If
53. LabelEnd:
54. Set objOraDb = Nothing
55. Set objOraSession = Nothing
57. End Sub
58. Function getSql() As String
59.  Dim strSql, strTemp As String
60.  Dim nCol, nRow As Integer
61.  nCol = 0   'the number of query condition, and should start from top left of the sheet1
62.  While (Sheet1.Cells(1, nCol + 1).Value <> "")
63.  nCol = nCol + 1
64.  Wend
65.  If nCol = 0 Then
66.  getSql = ""
67.  Exit Function
68.  End If
70.  '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 "
71.  strSql = "select * from PS_SUB_WZS_AT_VW_A where 1=1 "
72.  strTemp = ""
73.  For i = 1 To nCol  'collumn
74.     nRow = 2
75.     strTemp = ""
76.     Do
77.     If (Sheet1.Cells(nRow, i).Value <> "" And nRow = 2) Then
78.        strTemp = " and (" & Sheet1.Cells(1, i).Value & " like '%" & Sheet1.Cells(nRow, i).Value & "%' "
79.        ElseIf (Sheet1.Cells(nRow, i).Value <> "") Then
80.        strTemp = strTemp & " or " & Sheet1.Cells(1, i).Value & " like '%" & Sheet1.Cells(nRow, i).Value & "%'"
81.        ElseIf (Sheet1.Cells(nRow, i).Value = "" And nRow <> 2) Then
82. '       strTemp = strTemp & " aaa) "
83. '       ElseIf (Sheet1.Cells(nRow, i).Value = "") Then
84.        
85.     End If
86.     nRow = nRow + 1
87.     Loop Until (Sheet1.Cells(nRow, i).Value = "")
88.     
89.     If (strTemp <> "") Then
90.     strSql = strSql & strTemp
91.     strSql = strSql & ")"
92.     End If
93.  Next
94.  getSql = strSql
95. End Function