Export Excel to SQL using VBA - sql-server

Question

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.
While creating the macro in Visual Basic for Applications my code is as follows:
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.
The table I am trying to export to in SQL looks like this. I don't think I am getting an error on the EventTime as the data type is varchar(8) not a date/time data type...
My SQL table is as follows:
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:
RecordedPeriod EventDate ID DeptCode OpCode StartTime FinishTime Units
null 6/22/17 45318 DC DC 8:00:00 8:15:00 250

Answer 1

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.

Answer 2

ADO to the rescue.
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

Here is another way to do it. Maybe this is easier to follow...
Add a reference to: 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

Answer 4

In mssql, it recognise value of datetime at Excel as text , so you have to cast text as datetime.
cast('8:00' as datetime)
apply to your code with upper cast method .
also cells(i,1) catch numeric value.
Your sEventDate is string, so sEventDate = .Cells(iRowNo, 2).Text
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