使用 VBA 将 Excel 导出到 SQL

Question

提问by DRUIDRUID

Was hoping if someone could help re-script this for me. I have asked this question before but did not receive the help needed.

希望是否有人可以帮助我重新编写脚本。我以前问过这个问题，但没有得到所需的帮助。

I am trying to create a excel file with a macro attached to a button that will export the data to SQL.

我正在尝试创建一个带有宏的 excel 文件，该宏附加到将数据导出到 SQL 的按钮上。

While creating the macro in Visual Basic for Applications my code is as follows:

在 Visual Basic for Applications 中创建宏时，我的代码如下：

Sub Button1_Click()
  Dim conn As New ADODB.Connection
  Dim iRowNo As Integer
  Dim sRecordedPeriod, sEventDate, sID, sDeptCode, sOpCode, sStartTime, sFinishTime, sUnits  As String

  With Sheets("Sheet1")
    'Open a connection to SQL Server
    conn.Open "Provider=SQLOLEDB;Data Source=db1\db1;Initial Catalog=ProdTrack;Integrated Security=SSPI;"
    'Skip the header row
    iRowNo = 2
    'Loop until empty cell in FirstName
    Do Until .Cells(iRowNo, 1) = ""
        sRecordedPeriod = .Cells(iRowNo, 1)
        sEventDate = .Cells(iRowNo, 2)
        sID = .Cells(iRowNo, 3)
        sDeptCode = .Cells(iRowNo, 4)
        sOpCode = .Cells(iRowNo, 5)
        sStartTime = .Cells(iRowNo, 6)
        sFinishTime = .Cells(iRowNo, 7)
        sUnits = .Cells(iRowNo, 8)
        'Generate and execute sql statement to import the excel rows to SQL Server table
        conn.Execute "insert into dbo.TimeLog (RecordedPeriod, EventDate, ID, DeptCode, Opcode, StartTime, FinishTime, Units) values ('" & sRecordedPeriod & "', '" & sEventDate & "', '" & sID & "', '" & sDeptCode & "', '" & sOpCode & "', '" & sStartTime & "', '" & sFinishTime & "', '" & sUnits & "')"
        iRowNo = iRowNo + 1
    Loop

    MsgBox "Data Successfully Exported."
    conn.Close
    Set conn = Nothing
  End With
End Sub

I receive this error message when exporting.

导出时收到此错误消息。

Run-time error '2147217913 (80040e07)':
Conversion failed when converting date and/or time from character string.

运行时错误“2147217913 (80040e07)”：
从字符串转换日期和/或时间时转换失败。

The table I am trying to export to in SQL looks like this. I don't think I am getting an error on the EventTimeas the data type is varchar(8)not a date/time data type...

我试图在 SQL 中导出到的表看起来像这样。我认为我没有收到错误，EventTime因为数据类型varchar(8)不是日期/时间数据类型...

My SQL table is as follows:

我的SQL表如下：

    RecordedPeriod DATETIME NOT NULL DEFAULT (GETDATE()),
    EventDate (varchar(8), not null)
    ID (int, not null)
    DeptCode (varchar(2), not null)
    OpCode (varchar(2), not null)
    StartTime (time(0), not null)
    FinishTime (time(0), not null)
    Units (int, not null)

This is what my Excel table looks like:

这是我的 Excel 表格的样子：

RecordedPeriod  EventDate   ID      DeptCode    OpCode  StartTime   FinishTime  Units
null             6/22/17    45318   DC          DC      8:00:00     8:15:00     250

Answer 1

回答by BitAccesser

Here's the parameter approach:

这是参数方法：

Dim conn As ADODB.Connection
Dim cmd As ADODB.Command

Dim strSQL As String

strSQL = "INSERT INTO dbo.TimeLog " & _
    "(RecordedPeriod, EventDate, ID, DeptCode, Opcode, StartTime, FinishTime, Units) " & _
"VALUES (?,?,?,?,?,?,?,?);"

Set conn = New ADODB.Connection
conn.Open ""Provider=SQLOLEDB;Data Source=db1\db1;Initial Catalog=ProdTrack;Integrated Security=SSPI;"
'Skip the header row
iRowNo = 2"

Set cmd = New ADODB.Command

cmd.ActiveConnection = conn
cmd.CommandType = adCmdText
cmd.CommandText = strSQL

iRowNo = 2

With Sheets("Sheet1")
  'Loop until empty cell in FirstName
  Do Until .Cells(iRowNo, 1) = ""

  cmd.Parameters.Append _
    cmd.CreateParameter("pRecordedPeriod", adDBTimeStamp, adParamInput, 8, .Cells(iRowNo, 1))
  cmd.Parameters.Append _
    cmd.CreateParameter("pEventDate", adVarChar, adParamInput, 8, .Cells(iRowNo, 2))
  cmd.Parameters.Append _
    cmd.CreateParameter("pID", adInteger, adParamInput, , .Cells(iRowNo, 3))
  cmd.Parameters.Append _
    cmd.CreateParameter("pDeptCode", adVarChar, adParamInput, 2, .Cells(iRowNo, 4))
  cmd.Parameters.Append _
    cmd.CreateParameter("pOpCode", adVarChar, adParamInput, 2, .Cells(iRowNo, 5))
  cmd.Parameters.Append _
    cmd.CreateParameter("pStartTime", adDBTime, adParamInput, 0, .Cells(iRowNo, 6))
  cmd.Parameters.Append _
    cmd.CreateParameter("pFinishTime", adDBTime, adParamInput, 0, .Cells(iRowNo, 7))
  cmd.Parameters.Append _
    cmd.CreateParameter("pUnits", adInteger, adParamInput, , .Cells(iRowNo, 8))

  cmd.Execute

  iRowNo = iRowNo + 1
  Loop
End With

conn.Close
Set conn = Nothing

the DataTypeEnum

数据类型枚举

But this is not nice to code, compared to a DAO parameter-query. No named parameters, five parameters to configure. This is for Stored Procedures? For CRUDthis is no fun.

但是，与 DAO 参数查询相比，这对代码来说并不好。没有命名参数，需要配置五个参数。这是为了Stored Procedures？因为CRUD这不好玩。

Answer 2

回答by ASH

ADO to the rescue.

ADO 来救援。

Dim cn As New ADODB.Connection

''You should probably change Activeworkbook.Fullname to the
''name of your workbook
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _
& ActiveWorkbook.FullName _
 & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"

cn.Open strCon

s = "INSERT INTO [ODBC;Description=TEST;DRIVER=SQL Server;" _
& "SERVER=Server;Trusted_Connection=Yes;" _
& "DATABASE=test].SomeTable ( Col1, Col2, Col3, Col4 ) " _
& "SELECT  a.Col1, a.Col2, a.Col3, a.Col4 " _
& "FROM [Sheet2$] a " _
& "LEFT JOIN [ODBC;Description=TEST;DRIVER=SQL Server;" _
& "SERVER=Server;Trusted_Connection=Yes;" _
& "DATABASE=test].SomeTable b ON a.Col1 = b.Col1 " _
& "WHERE b.Col1 Is Null"
cn.Execute s

Also, check out these links.

另外，请查看这些链接。

https://www.excel-sql-server.com/excel-sql-server-import-export-using-vba.htm

http://tomaslind.net/2013/12/26/export-data-excel-to-sql-server/

Answer 3

回答by Dy.Lee

In mssql, it recognise value of datetime at Excel as text , so you have to cast text as datetime.

在 mssql 中，它将 Excel 中日期时间的值识别为 text ，因此您必须将文本转换为日期时间。

cast('8:00' as datetime)

cast('8:00' 作为日期时间)

apply to your code with upper cast method .

使用 upper cast 方法应用于您的代码。

also cells(i,1) catch numeric value.

单元格（i，1）也捕获数值。

Your sEventDate is string, so sEventDate = .Cells(iRowNo, 2).Text

你的 sEventDate 是字符串，所以 sEventDate = .Cells(iRowNo, 2)。文本

Sub Button1_Click()
  Dim conn As New ADODB.Connection
  Dim iRowNo As Integer
  Dim sRecordedPeriod, sEventDate, sID, sDeptCode, sOpCode, sStartTime, sFinishTime, sUnits  As String

  With Sheets("Sheet1")
    'Open a connection to SQL Server
    conn.Open "Provider=SQLOLEDB;Data Source=db1\db1;Initial Catalog=ProdTrack;Integrated Security=SSPI;"
    'Skip the header row
    iRowNo = 2
    'Loop until empty cell in FirstName
    Do Until .Cells(iRowNo, 1) = ""
        sRecordedPeriod = .Cells(iRowNo, 1)
        sEventDate = .Cells(iRowNo, 2).Text
        sID = .Cells(iRowNo, 3)
        sDeptCode = .Cells(iRowNo, 4)
        sOpCode = .Cells(iRowNo, 5)
        sStartTime = .Cells(iRowNo, 6)
        sFinishTime = .Cells(iRowNo, 7)
        sUnits = .Cells(iRowNo, 8)
        'Generate and execute sql statement to import the excel rows to SQL Server table
        conn.Execute "insert into dbo.TimeLog (RecordedPeriod, EventDate, ID, DeptCode, Opcode, StartTime, FinishTime, Units) values ( '" & sRecordedPeriod & "' , '" & sEventDate & "'  , '" & sID & "', '" & sDeptCode & "', '" & sOpCode & "', cast('" & sStartTime & "' as datetime) , cast('" & sFinishTime & "' as datetime), '" & sUnits & "')"
        iRowNo = iRowNo + 1
    Loop

    MsgBox "Data Successfully Exported."
    conn.Close
    Set conn = Nothing
  End With
End Sub

Answer 4

回答by ASH

Here is another way to do it. Maybe this is easier to follow...

这是另一种方法。也许这更容易遵循......

Add a reference to: Microsoft ActiveX Data Objects 2.8 Library

添加对：Microsoft ActiveX Data Objects 2.8 Library 的引用

Sub Button_Click()
'TRUSTED CONNECTION
    On Error GoTo errH

    Dim con As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim strPath As String
    Dim intImportRow As Integer
    Dim strFirstName, strLastName As String

    Dim server, username, password, table, database As String


    With Sheets("Sheet1")

            server = .TextBox1.Text
            table = .TextBox4.Text
            database = .TextBox5.Text


            If con.State <> 1 Then

                con.Open "Provider=SQLOLEDB;Data Source=" & server & ";Initial Catalog=" & database & ";Integrated Security=SSPI;"
                'con.Open

            End If
            'this is the TRUSTED connection string

            Set rs.ActiveConnection = con

            'delete all records first if checkbox checked
            If .CheckBox1 Then
                con.Execute "delete from tbl_demo"
            End If

            'set first row with records to import
            'you could also just loop thru a range if you want.
            intImportRow = 10

            Do Until .Cells(intImportRow, 1) = ""
                strFirstName = .Cells(intImportRow, 1)
                strLastName = .Cells(intImportRow, 2)

                'insert row into database
                con.Execute "insert into tbl_demo (firstname, lastname) values ('" & strFirstName & "', '" & strLastName & "')"

                intImportRow = intImportRow + 1
            Loop

            MsgBox "Done importing", vbInformation

            con.Close
            Set con = Nothing

    End With

Exit Sub

errH:
    MsgBox Err.Description
End Sub

使用 VBA 将 Excel 导出到 SQL

提问by DRUIDRUID

回答by BitAccesser

回答by ASH

回答by Dy.Lee

回答by ASH

相关推荐

最近更新

标签

使用 VBA 将 Excel 导出到 SQL

提问by DRUIDRUID

回答by BitAccesser

回答by ASH

回答by Dy.Lee

回答by ASH

相关推荐

VBA Excel 查找范围内的单词并替换

在对 SQL Server 的直通查询中访问 VBA 参数

vba excel：运行宏后取消选择范围

vba 执行直到 ActiveCell 为空

相关推荐

最近更新

标签