作者：iamlaosong
网络应用程序一般有两种结构形式，就是所谓的C/S结构和B/S结构，通过Excel和数据库的配合，可以实现简单C/S结构的应用程序，客户端只要安装数据库客户端和Excel应用即可。下面介绍VBA实现Excel和Oracle数据库交换技术的关键点。
1、数据库连接
[vb]
Set cnn = CreateObject("ADODB.Connection")
cnn.Open "Provider=msdaora;Data Source=dl580;User Id=emssxjk;Password=emssxjk;"
2、将Excel数据更新或插入到数据库表中
[vb]
Set cnn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
sqls = "connect database"
cnn.Open "Provider=msdaora;Data Source=dl580;User Id=emssxjk;Password=emssxjk;"
OraOpen = True '成功执行后，数据库即被打开
'If OraOpen Then lineno = [D65536].End(xlUp).Row Else lineno = 0 '行数
For i = Minfield To Maxfield
myrecord(i) = Worksheets("客户录入").Cells(i, 2)
Next i
myrecord(i) = Now()
sqls = "select count(*) from EMSAPP_MAP_TABLE where CLIENT_ID ='" & myrecord(Minfield) & "'"
Set rst = cnn.Execute(sqls)
If rst(0) > 0 Then
'ID已经存在，更新客户资料
i = Minfield + 1
sqls = "update EMSAPP_MAP_TABLE set CLIENT_NAME='" & myrecord(i) & "',"
sqls = sqls & "CLIENT_ADDR='" & myrecord(i + 1) & "',"
sqls = sqls & "PROD_FLOW = '" & myrecord(i + 2) & "',"
sqls = sqls & "UNIT_SCALE ='" & myrecord(i + 3) & "',"
sqls = sqls & "DEMAND_EXPRESS='" & myrecord(i + 4) & "',"
sqls = sqls & "MAIL_SITUATION='" & myrecord(i + 5) & "',"
sqls = sqls & "UNIT_PROP='" & myrecord(i + 6) & "',"
sqls = sqls & "INDUSTRY_CAT='" & myrecord(i + 7) & "',"
sqls = sqls & "DELIVERY_MODE='" & myrecord(i + 8) & "',"
sqls = sqls & "COLLECT_MODE='" & myrecord(i + 9) & "',"
sqls = sqls & "RESPONSE_MODE='" & myrecord(i + 10) & "',"
sqls = sqls & "SERVICE_MODE='" & myrecord(i + 11) & "',"
sqls = sqls & "MAIL_COMPETOR='" & myrecord(i + 12) & "',"
sqls = sqls & "CONTACT_NAME='" & myrecord(i + 13) & "',"
sqls = sqls & "CONTACT_PHONE='" & myrecord(i + 14) & "',"
sqls = sqls & "REMARK='" & myrecord(i + 15) & "' where CLIENT_ID = '" & myrecord(Minfield) & "'"
Else
sqls = "insert into EMSAPP_MAP_TABLE (CLIENT_ID,CLIENT_NAME,CLIENT_ADDR,PROD_FLOW,UNIT_SCALE,DEMAND_EXPRESS,"
sqls = sqls & "MAIL_SITUATION,UNIT_PROP,INDUSTRY_CAT,DELIVERY_MODE,COLLECT_MODE,RESPONSE_MODE,SERVICE_MODE,"
sqls = sqls & "MAIL_COMPETOR,CONTACT_NAME,CONTACT_PHONE,REMARK,CREATE_DATE) values ('"
For i = Minfield To Maxfield
sqls = sqls & myrecord(i) & "','"
Next i
sqls = sqls & myrecord(i) & "')"
End If
Set rst = cnn.Execute(sqls)
3、将表中的数据读入Excel工作表中
(1) 直接引用记录集
记录集中字段的引用可以通过字段名，如rst("CLIENT_ID")，也可以通过序号如rst(2)，注意，序号从0开始，rst(2)表示第3个字段。多条记录时通过rst.movenext进行移动，在默认情况下，当打开记录集，为向前指针，只能用MoveNext方法向前单向移动指针，其他操作不受支持。
[vb]
<span style="font-size:12px"> Set cnn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
sqls = "connect database"
cnn.Open "Provider=msdaora;Data Source=dl580;User Id=emssxjk;Password=emssxjk;"
OraOpen = True '成功执行后，数据库即被打开
'If OraOpen Then lineno = [D65536].End(xlUp).Row Else lineno = 0 '行数
sqls = "select CLIENT_ID,CLIENT_NAME,CLIENT_ADDR,PROD_FLOW,UNIT_SCALE,DEMAND_EXPRESS,MAIL_SITUATION,"
sqls = sqls & "UNIT_PROP,INDUSTRY_CAT,DELIVERY_MODE,COLLECT_MODE,RESPONSE_MODE,SERVICE_MODE,MAIL_COMPETOR,"
sqls = sqls & "CONTACT_NAME,CONTACT_PHONE,REMARK,CREATE_DATE from EMSAPP_MAP_TABLE where CLIENT_ID ='" & id & "'"
Set rst = cnn.Execute(sqls)
'MsgBox sqls
If Not (rst.EOF) Then
For i = Minfield To Maxfield
Worksheets("客户录入").Cells(i, 2) = rst(i - Minfield) '记录集rst()下标从0开始
Next i
Worksheets("客户录入").Cells(Maxfield, 3) = "老客户，创建时间：" & rst(i - Minfield)
msg = MsgBox("成功读取老客户资料!", vbOKOnly, "iamlaosong")
Else
msg = MsgBox("老客户资料不存在!", vbOKOnly, "iamlaosong")
End If
</span>
(2) 将记录集保存到表中
[html]
' 数据读入到名字由name变量指定的工作表中
Set rst = cnn.Execute(sqls)
Maxrow = Sheets(name).[A65536].End(xlUp).Row + 1
Sheets(name).Range("a3:" & field & Maxrow).ClearContents
Sheets(name).Range("a3").CopyFromRecordset rst
