excel导入oracle guid,【VBA】 通过VBA脚本将EXCEL的数据导入 ORACLE

作者：lianghc

描述：最近在使用infamatica 将excel  的数据导入oracle时，遇到意外终止错误，无法将数据导入。于是采用VBA将数据导入数据库，是办公人员一键同步excel的数据导数据库中，这种做法的前提是提供标准的模板。下面是解决问题过程中收集的连接数据库的方法，整理一下供大家参考。

1、引用法 引用ADO相关组件：打开VBA编辑器，在菜单中点选“工具”--》“引用”。确保“Microsoft ActiviteX Data Objects 2.8 Library”和“Microsoft ActiviteX Data ObjectS Recordset 2.8 Library”被勾选上。引用后再声明:

Dim cnn As New Connection '声明链接对象

Dim rst As New Recordset '声明记录集对象

例子：

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

2、创建法 不需要引用ADO相关组件，直接使用CreateObject函数创建ADO对象，即：

Set cnn = CreateObject("ADODB.connection") '创建ado对象

Set rst = CreateObject("ADODB.recordset") '创建记录集

下面是例程(和上面例程类似，前半部分不同，后面的相同)：

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 '成功执行后，数据库即被打开

其它组件的使用也和这个差不多，建议用创建法，这样就不用管“引用”中的设置了，例如：

Dim dic As Object '直接创建不需要引用

Set dic = CreateObject("scripting.dictionary") '创建字典对象

Dim fso as Object '直接创建不需要引用

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