Dim cnn As New Connection
Dim rst As New Recordset
cnn.Open "Provider=msdaora.1;Data Source=dl580;User Id=emssxjk;Password=emssxjk;"
OraOpen = True '成功执行后,数据库即被打开
sqls = "select count(*) from tb_evt_dlv where mail_num='" & emsid & "'"
Set rst = cnn.Execute(sqls)
If rst(0) > 0 Then
sqls = "select b.zj_code,b.zj_mc,b.jgfl,b.city,b.ssxs from tb_evt_dlv a, tb_jg b "
sqls = sqls & "where a.dlv_bureau_org_code = b.zj_code and a.mail_num='" & emsid & "' and rownum=1"
Set rst = cnn.Execute(sqls)
sqls = "CopyFromRecordset"
'maxrow = Sheets(qfxx).[A65536].End(xlUp).Row
'If maxrow > 1 Then Sheets(qfxx).Range("a2:H" & maxrow).ClearContents
Cells(row1, pos_sav).CopyFromRecordset rst
Else
sqls = "select b.zj_code,b.zj_mc,b.jgfl,b.city,b.ssxs from tb_evt_mail_clct a, tb_jg b "
sqls = sqls & "where a.clct_bureau_org_code = b.zj_code and a.mail_num='" & emsid & "' and rownum=1"
Set rst = cnn.Execute(sqls)
sqls = "CopyFromRecordset"
'maxrow = Sheets(qfxx).[A65536].End(xlUp).Row
'If maxrow > 1 Then Sheets(qfxx).Range("a2:H" & maxrow).ClearContents
Cells(row1, pos_sav + 5).CopyFromRecordset rst
End If
Dim cnn As Object, rst As Object
Set cnn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
cnn.Open "Provider=msdaora.1;Data Source=dl580;User Id=emssxjk;Password=emssxjk;"
OraOpen = True '成功执行后,数据库即被打开
Set fso = CreateObject("Scripting.FileSystemObject") '创建文件对象模型
上面内容引自:http://blog.csdn.net/iamlaosong/article/details/45096059 (这个博客写的不错)
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Declare Function CoCreateGuid Lib "OLE32.DLL" (pGuid As GUID) As Long
Public Function GetGUID() As String
'(c) 2000 Gus Molina
Dim udtGUID As GUID
If (CoCreateGuid(udtGUID) = 0) Then
GetGUID = _
String(8 - Len(Hex$(udtGUID.Data1)), "0") & Hex$(udtGUID.Data1) & _
String(4 - Len(Hex$(udtGUID.Data2)), "0") & Hex$(udtGUID.Data2) & _
String(4 - Len(Hex$(udtGUID.Data3)), "0") & Hex$(udtGUID.Data3) & _
IIf((udtGUID.Data4(0) < &H10), "0", "") & Hex$(udtGUID.Data4(0)) & _
IIf((udtGUID.Data4(1) < &H10), "0", "") & Hex$(udtGUID.Data4(1)) & _
IIf((udtGUID.Data4(2) < &H10), "0", "") & Hex$(udtGUID.Data4(2)) & _
IIf((udtGUID.Data4(3) < &H10), "0", "") & Hex$(udtGUID.Data4(3)) & _
IIf((udtGUID.Data4(4) < &H10), "0", "") & Hex$(udtGUID.Data4(4)) & _
IIf((udtGUID.Data4(5) < &H10), "0", "") & Hex$(udtGUID.Data4(5)) & _
IIf((udtGUID.Data4(6) < &H10), "0", "") & Hex$(udtGUID.Data4(6)) & _
IIf((udtGUID.Data4(7) < &H10), "0", "") & Hex$(udtGUID.Data4(7))
End If
End Function
’前面的是生成唯一标识GUID的代码。
Sub Table_to_Oracle()
Set cnn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
Dim datasource As String
Dim userid As String
Dim password As String
On Error GoTo Err_Handle '如果遇到错误就跳转到错误处,并提示错误
ThisWorkbook.Sheets("1").Select '将连接信息存在表格里
datasource = ""
userid = ""
password = ""
cnn.Open "Provider=msdaora;Data Source=" & datasource & ";User Id=" & userid & ";Password=" & password & ";" '打开数据库连接
C_TEST= GetGUID '插入32位的GUID
If deleteflag Then
cnn.Execute ("delete from TOP_REPAYPLAN where C_PROJECTCODE= " & C_PROJECTCODE)
deleteflag = False
End If
insert_sql = "insert into TABLE_TEST(C_TEST) "
value_sql = " values(" & C_TEST & ")"
Set rst = cnn.Execute(insert_sql & value_sql)
cnn.Close
MsgBox "成功导入!", vbInformation, "导入信息"
Exit Sub
Err_Handle:
MsgBox Err.Description, vbExclamation, "异常信息"
End Sub
Sub readme()
MsgBox "您好,数据导入过程中如果有出错信息,请联系开发人员。", vbInformation, "友情提示"
End Sub
'网上收集的另一段比较好的代码:
Public Sub ConOra()
On Error GoTo ErrMsg:
Dim ConnDB As ADODB.Connection
Set ConnDB = New ADODB.Connection
Dim ConnStr As String
Dim DBRst As ADODB.Recordset
Set DBRst = New ADODB.Recordset
Dim SQLRst As String
Dim OraOpen As Boolean
OraOpen = False
OraID = "orcl" 'Oracle数据库的相关配置
OraUsr = "scott"
OraPwd = "tiger"
ConnStr = "Provider = MSDAORA.1;Password=" & OraPwd & _
";User ID=" & OraUsr & _
";Data Source=" & OraID & _
";Persist Security Info=True"
ConnDB.CursorLocation = adUseServer
ConnDB.Open ConnStr
OraOpen = True '成功执行后,数据库即被打开
'MsgBox "Connect to the oracle database Successful!", vbInformation, "Connect Successful"
DBRst.ActiveConnection = ConnDB
DBRst.CursorLocation = adUseServer
DBRst.LockType = adLockBatchOptimistic
SQLRst = "Select * From TB_USER"
DBRst.Open SQLRst, ConnDB, adOpenStatic, adLockBatchOptimistic
For Each x In DBRst.Fields
x.Name
Next
Do Until DBRst.EOF
For Each i In DBRst.Fields
Response.Write (i.Value)
Next
DBRst.MoveNext
Loop
DBRst.Close
DBRst.MoveFirst
Exit Sub
ErrMsg:
OraOpen = False
MsgBox "Connect to the oracle database fail ,please check!", vbCritical, "Connect fail!"
End Sub