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个。
附件列表