使用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个。

来自为知笔记(Wiz)

附件列表