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