使用VBA把EXCEL数据导入数据库
Dim table_Name$
Sub JugeData()
Dim i%, Cnum%, dt$, arry1 () As String, arry2 () As String, arry3 () As String, cnn As Object, rst As Object
cdt = Format(Date, "MMDD")
table_Name = InputBox("请输入数据库表名", "数据库表名", "ygl_temp" & cdt)
Cnum = ActiveSheet.Range("a1"). CurrentRegion.Columns.Count
On Error GoTo errmsg
'定义字段为文本类型
For i = 1 To Cnum
ReDim Preserve arry2(i - 1)
dt = ActiveSheet.Cells(1, i).Value
dt2 = FindDataType(dt )
arry2(i - 1) = dt2 & " varchar2(800)"
Next
'生成建表语句
str1 = Join(arry2, " , " )
str2 = "create table " & table_Name & " (" & str1 & " )"
'MsgBox str2
Set cnn = CreateObject ("ADODB.Connection" )
Set rst = CreateObject ("ADODB.Recordset" )
cnn.Open "Provider=OraOLEDB.Oracle.1;Data Source=cd;User Id=user;Password=password;"
sql = str2
cnn.Execute (sql)
MsgBox "create table OK"
cnn.Close
Set rst = Nothing
Set cnn = Nothing
Call 插入数据
Exit Sub
errmsg:
MsgBox Err.Description, , "错误报告"
End Sub
Function FindDataType(V_cell As String)
'替换标题里的特殊字符
If V_cell = "" Then V_cell = "空的"
If IsNumeric(Left (V_cell, 1 )) = True Then V_cell = "a" & V_cell
If Len(V_cell) >= 15 Then V_cell = Left (V_cell, 14 )
If InStr(V_cell , "/") Then V_cell = Replace (V_cell, "/" , "_")
If InStr(V_cell , "'") Then V_cell = Replace (V_cell, "'" , "")
FindDataType = V_cell
End Function
Sub 插入数据()
Dim tt, arr1(), i% , j%, str$ , arr2(), str2$
tt = Timer
Dim cnn As Object, sql$ , rst As Object
arr1 = ActiveSheet.Range("a1"). CurrentRegion.Value
Set cnn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
On Error GoTo errmsg
cnn.Open "Provider=OraOLEDB.Oracle.1;Data Source=cd;User Id=stat_yg;Password=yg12345;"
'构造插入语句
sql = "insert into " & table_Name & " values ("
'从第2行开始插入数据
For i = 2 To UBound(arr1, 1)
For j = 1 To UBound (arr1, 2 )
ReDim Preserve arr2(j - 1)
'在单元格内容插入单引号
arr2 (j - 1) = "'" & arr1(i, j ) & "'"
Next
str = Join( arr2, ",")
'执行插入语句
str2 = sql & str & ")"
cnn.Execute (str2)
Next
MsgBox "ok,用了" & Timer - tt & "秒"
cnn.Close
Set cnn = Nothing
Exit Sub
errmsg:
MsgBox Err.Description, , "错误报告"
End Sub
2014.10.21 增加重复字段名处理，字段名含（,(,-的处理，修改插入数据行变量I为LONG类型，解决超过3W行整形数据溢出问题
2014.11.26 增加对字段名包含换行符的处理，对字段名第一个字符为特殊字符的处理，替换2个下划线为1个。![]()
附件列表
