使用VBA将Excel导出到SQL

希望如果有人能帮我重新编写脚本。 我曾经问过这个问题，但没有得到所需的帮助。

我试图创build一个附加到一个button，将数据导出到SQL的macros的Excel文件。

在Visual Basic for Applications中创buildmacros时，我的代码如下所示：

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 

导出时收到此错误消息。

运行时错误'2147217913（80040e07）'：

从string转换date和/或时间时转换失败。

我试图导出到SQL中的表看起来像这样。 我不认为我得到一个EventTime的错误，因为数据types是varchar(8)而不是date/时间数据types…

我的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) 

这是我的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

这是参数方法：

 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 

DataTypeEnum

但是与DAO参数查询相比，这不是很好的代码。 没有命名参数，五个参数configuration。 这是用于Stored Procedures ？ 对于CRUD这并不好玩。

Answer 2

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 

另外，请查看这些链接。

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

这是另一种方式来做到这一点。 也许这是更容易遵循…

添加对Microsoft ActiveX数据对象2.8库的引用

 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 

Answer 4

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

（'8:00'作为date时间）

用上面的cast方法应用你的代码。

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

你的sEventDate是string，所以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