export entire excel sheet to sql table with VBA - sql-server

having issue sending entire sheet to sql table. I have tried 2 different ways as shown below. both work in different ways. Ultimately I am struggling with exporting multiple rows of data to sql DB
this 1st way I can import multiple rows to sql table successfully with one click of the button, only problem is that the StartTime and FinishTime come to sql table as 00:00:00 even if I enter a normal time in excel
Sub Button1_Click()
Dim conn As New ADODB.Connection
Dim iRowNo As Integer
Dim sEventDate, sID, sDeptCode, sOpCode, sStartTime, sFinishTime, sUnits As String
With Sheets("Sheet1")
'Open a connection to SQL Server
conn.Open "Provider=SQLOLEDB;Data Source=db\db1;Initial Catalog=PTW;Integrated Security=SSPI;"
'Skip the header row
iRowNo = 2
'Loop until empty cell in FirstName
Do Until .Cells(iRowNo, 1) = ""
sEventDate = .Cells(iRowNo, 1)
sID = .Cells(iRowNo, 2)
sDeptCode = .Cells(iRowNo, 3)
sOpCode = .Cells(iRowNo, 4)
sStartTime = .Cells(iRowNo, 5).Text
sFinishTime = .Cells(iRowNo, 6).Text
sUnits = .Cells(iRowNo, 7)
'Generate and execute sql statement to import the excel rows to SQL Server table
conn.Execute "insert into dbo.TimeLog (EventDate, ID, DeptCode, Opcode, StartTime, FinishTime, Units) values ('" & sEventDate & "', '" & sID & "', '" & sDeptCode & "', '" & sOpCode & "', cast('" & dStartTime & "' as datetime), cast('" & dFinishTime & "' as datetime), '" & sUnits & "')"
iRowNo = iRowNo + 1
Loop
MsgBox "Data Successfully Exported."
conn.Close
Set conn = Nothing
End With
End Sub
this 2nd way works and sends the StartTime and FinishTime exactly as it is in excel table, but it only allows me to send one row to sql table at a time
Sub Button1_Click()
Dim conn As ADODB.Connection
Dim cmd As ADODB.Command
Dim strSQL As String
strSQL = "INSERT INTO dbo.TimeLog" & _
"(EventDate, ID, DeptCode, Opcode, StartTime, FinishTime, Units) " & _
"VALUES (?,?,?,?,?,?,?)"
Set conn = New ADODB.Connection
conn.Open "Provider=SQLOLEDB;Data Source=db\db1;Initial Catalog=PTW;Integrated Security=SSPI;"
iRowNo = 1
Set cmd = New ADODB.Command
cmd.ActiveConnection = conn
cmd.CommandType = adCmdText
cmd.CommandText = strSQL
With Sheets("Sheet1")
'Loop until empty cell in FirstName
Do Until .Cells(iRowNo, 1) = ""
cmd.Parameters.Append _
cmd.CreateParameter("pEventDate", adVarChar, adParamInput, 8, .Cells(iRowNo, 1))
cmd.Parameters.Append _
cmd.CreateParameter("pID", adInteger, adParamInput, , .Cells(iRowNo, 2))
cmd.Parameters.Append _
cmd.CreateParameter("pDeptCode", adVarChar, adParamInput, 2, .Cells(iRowNo, 3))
cmd.Parameters.Append _
cmd.CreateParameter("pOpCode", adVarChar, adParamInput, 2, .Cells(iRowNo, 4))
cmd.Parameters.Append _
cmd.CreateParameter("pStartTime", adDBTime, adParamInput, 0, .Cells(iRowNo, 5))
cmd.Parameters.Append _
cmd.CreateParameter("pFinishTime", adDBTime, adParamInput, 0, .Cells(iRowNo, 6))
cmd.Parameters.Append _
cmd.CreateParameter("pUnits", adInteger, adParamInput, , .Cells(iRowNo, 7))
cmd.Execute
iRowNo = iRowNo + 1
Loop
MsgBox "Data Successfully Exported"
End With
conn.Close
Set conn = Nothing
End Sub

you must cast the value. In mssql, yourt time value is recognized as string.
cast('8:00:00' as datetime)
conn.Execute "insert into dbo.TimeLog (EventDate, ID, DeptCode, Opcode, StartTime, FinishTime, Units) values ('" & sEventDate & "', '" & sID & "', '" & sDeptCode & "', '" & sOpCode & "', cast('" & dStartTime & "' as datetime), cast('" & dFinishTime & "' as datetime), '" & sUnits & "')"

Adding this inside the loop of the first script was the result I was looking for...
Set cmd = New ADODB.Command
cmd.ActiveConnection = conn
cmd.CommandType = adCmdText
cmd.CommandText = strSQL

Related

VB6 More than 10 parameters for stored procedure

I have problem in vb6 when I'm trying to insert parameters that are more than 10, 9 below are fine.
When I try from '#1' to '#9' its fine, the output will be strsql = '1st value'...'9th value', but when I with 10 parameter it outputs strsql = '#1'...'#10'
Set rsOR = New ADODB.Recordset
strSql = SQLParams("DB..sp_Insert '#1','#2','#3','#4','#5','#6','#7','#8','#9','#10'", cbPayor.Text, "COLLECTION", txtORCol.Text, dtCol.Value, UserID, CollectionType, txtAmountCol.Text, "PHP", dtColCash.Value, txtCheque.Text)
clsSession.Execute strSql, rsOR
No error using
'#1'...'#9'
FROM: strSql = SQLParams("DB..sp_Insert '#1',...,'#9'", cbPayor.Text, "COLLECTION")
OUTPUTS: strsql "DB..sp_Insert 'text here',.... ,'COLLECTION'
Error using
'#1'...'#10'
FROM: strSql = SQLParams("DB..sp_Insert '#1',...,'#10'", cbPayor.Text, "COLLECTION")
OUTPUTS: strsql "DB..sp_Insert '#1'...'#10'
After a bit of googling I found this (there should be no 9 field limit):
Dim strSQL As String
Dim cmd As New ADODB.Command
strSQL = "UPDATE MyTable SET " & vbNewLine _
& " NEEDS_ID = #NEEDS_ID, " & vbNewLine _
& " OBJ_ID = #OBJ_ID, " & vbNewLine _
& " OBJ_COMMENTS = #OBJ_COMMENTS, " & vbNewLine _
& " TIME21_ID = #TIME21_ID, " & vbNewLine _
& " WHERE ID = #WHEREID"
With cmd
.ActiveConnection = Cn
.CommandText = strSQL
.Parameters.Append .CreateParameter("#NEEDS_ID", adInteger, adParamInput, 2, 12)
.Parameters.Append .CreateParameter("#OBJ_ID", adInteger, adParamInput, 2, 23)
.Parameters.Append .CreateParameter("#OBJ_COMMENTS", adVarChar, adParamInput, 250, "Some text")
.Parameters.Append .CreateParameter("#TIME21_ID", adInteger, adParamInput, 2, 34)
.Parameters.Append .CreateParameter("#WHEREID", adInteger, adParamInput, 18, 456)
.Execute
End With

Export Excel to SQL without duplicate values

I have success making a connection between Excel and SQL with managing to add records from Excel cells to SQL database table and this is the tutorial i did:
Export data from Excel to SQL Server
a (Sign up form) i made in excel Sign up form i made , and i manage to make a Macro to (Sign Up) button to transfer the data into the SQL database and this is the code for a reference :
Sub connect()
Dim conn As New ADODB.Connection
Dim iRowNo As Integer
' Dim sCustomerId, sFirstName, sLastName As String
With Sheets("Sheet2")
'Open a connection to SQL Server
conn.Open "Provider=SQLOLEDB;Data Source=seshbones\bones;Initial Catalog=fadi;Integrated Security=SSPI;"
'Skip the header row
iRowNo = 2
'Loop until empty cell in CustomerId
Do Until .Cells(iRowNo, 1) = ""
Name = .Cells(iRowNo, 1)
Location = .Cells(iRowNo, 2)
Age = .Cells(iRowNo, 3)
ID = .Cells(iRowNo, 4)
Mobile = .Cells(iRowNo, 5)
Email = .Cells(iRowNo, 6)
'Generate and execute sql statement to import the excel rows to SQL Server table
conn.Execute "insert into dbo.test (Name, Location, Age, ID, Mobile, Email) values ('" & Name & "', '" & Location & "', '" & Age & "', '" & ID & "', '" & Mobile & "', '" & Email & "')"
iRowNo = iRowNo + 1
Loop
MsgBox "Customers imported."
conn.Close
Set conn = Nothing
End With
me in the table
End Sub
I want to make a restriction code to not duplicate the same Username in the table, for example if the customer enters a (Username) in excel cell and pressed (SignUP) there must have a function that check the SQL database and check the Username is already taken and refuse to make the exporting and message box appears "User is already taken" i hope you got my point.
Thank you for your help guys i added the error handler code to my project, so if there a duplicate records in my database it will prevent my program from shutting down and simply warn the user "Username Already taken" this is my how i fix the code :
Sub Connect()
Dim conn As New ADODB.Connection
Dim iRowNo As Integer
' Dim sCustomerId, sFirstName, sLastName As String
'Error handler
On Error GoTo ErrHandler:
With Sheets("Sheet2")
'Open a connection to SQL Server
conn.Open "Provider=SQLOLEDB;Data Source=seshbones\bones;Initial Catalog=fadi;Integrated Security=SSPI;"
'Skip the header row
iRowNo = 2
'Loop until empty cell in CustomerId
Do Until .Cells(iRowNo, 1) = ""
Name = .Cells(iRowNo, 1)
Location = .Cells(iRowNo, 2)
Age = .Cells(iRowNo, 3)
ID = .Cells(iRowNo, 4)
Mobile = .Cells(iRowNo, 5)
Email = .Cells(iRowNo, 6)
'Generate and execute sql statement to import the excel rows to SQL Server table
conn.Execute "insert into dbo.test (Name, Location, Age, ID, Mobile, Email) values ('" & Name & "', '" & Location & "', '" & Age & "', '" & ID & "', '" & Mobile & "', '" & Email & "')"
iRowNo = iRowNo + 1
Loop
MsgBox "Customers imported."
conn.Close
Set conn = Nothing
End With
Exit Sub
ErrHandler:MsgBox "Username Already taken" End Sub

Data not uploading to MS SQL database.

I'm trying to push a button in an excel worksheet and it should send the data from the a worksheet to the sql table. But this vba code is not uploading the data from excel to the database. I have similar other table and it works fine. Any suggestions or thoughts on this would be great.
Sub Send2SQL()
Dim cmd As New ADODB.Command
Dim rst As ADODB.Recordset
Dim UploadTime, SubmissionNumber, WorkbookSection, DataDescription1, DataDescription2, DataDescription3
Dim iValue, sValue, fValue, bValue, dValue, Omit
Dim UploadRow As Integer
Dim LastRow As Integer
'Establish Error Handler
On Error GoTo ErrorHandler
'Determine UploadTime
UploadTime = Format(Now, "mm\/dd\/yyyy hh\:mm\:ss")
'Loop Through Upload
For UploadRow = 2 To LastRow
With Sheets("DataCapture")
WorkbookSection = .Cells(UploadRow, WorkbookSectionColumn).Value
DataDescription1 = .Cells(UploadRow, DataDescription1Column).Value
DataDescription2 = .Cells(UploadRow, DataDescription2Column).Value
DataDescription3 = .Cells(UploadRow, DataDescription3Column).Value
iValue = .Cells(UploadRow, iValueColumn).Value
sValue = Left(.Cells(UploadRow, sValueColumn).Value, 400)
If sValue = "" Then sValue = Empty
fValue = .Cells(UploadRow, fValueColumn).Value
bValue = .Cells(UploadRow, bValueColumn).Value
dValue = .Cells(UploadRow, dValueColumn).Value
End With
With cmd
.ActiveConnection = conn
.CommandType = adCmdStoredProc
.CommandText = "[DataUpload]"
.Parameters.Append .CreateParameter("#TimeOfUpload", adDBTimeStamp, adParamInput, , UploadTime)
.Parameters.Append .CreateParameter("#WorkbookSection", adVarChar, adParamInput, 60, WorkbookSection)
.Parameters.Append .CreateParameter("#DataDescription1", adVarChar, adParamInput, 255, DataDescription1)
.Parameters.Append .CreateParameter("#DataDescription2", adVarChar, adParamInput, 60, DataDescription2)
.Parameters.Append .CreateParameter("#DataDescription3", adVarChar, adParamInput, 60, DataDescription3)
.Parameters.Append .CreateParameter("#iValue", adBigInt, adParamInput, , iValue)
.Parameters.Append .CreateParameter("#sValue", adVarChar, adParamInput, 400, sValue)
.Parameters.Append .CreateParameter("#fValue", adDouble, adParamInput, , fValue)
.Parameters.Append .CreateParameter("#bValue", adBoolean, adParamInput, , bValue)
.Parameters.Append .CreateParameter("#dValue", adDate, adParamInput, , dValue)
.Parameters.Append .CreateParameter("#FileID", adBigInt, adParamInput, , rstOut)
Set rst = .Execute
End With
Set cmd = New ADODB.Command
Next UploadRow
'Turn off ErrorHandler & Exit Sub
On Error GoTo 0
Exit Sub
ErrorHandler:
MsgBox "There was an Error Uploading your data" & vbNewLine & vbNewLine & "An Automated Email has been sent to Sai Latha Suresh from Acturaial"
On Error GoTo 0
End
End Sub
You are using Execute on your Recordset, when you should be using Execute on your Command object.
From Excel to SQL Server? Try it this way.
Sub Rectangle1_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
My setup looks like this.
Also.......Excel VBA - Update SQL Server Table:
http://www.cnblogs.com/anorthwolf/archive/2012/04/25/2470250.html
http://www.excel-sql-server.com/excel-sql-server-import-export-using-vba.htm
...More
http://www.ozgrid.com/forum/showthread.php?t=169953
http://stackoverflow.com/questions/2567150/excel-vba-sql-data
http://msgroups.net/microsoft.public.excel.programming/vba-to-export-large-tables/61433
http://www.codeproject.com/Questions/475817/Howplustoplusupdateplussqlplusserverplusdataplusfr
http://www.excelguru.ca/forums/showthread.php?992-SQL-Select-Insert-Update-queries-from-Excel-vba
http://www.mrexcel.com/forum/excel-questions/617303-updating-records-access-table-using-excel-visual-basic-applications.html
http://www.excelforum.com/excel-programming-vba-macros/501147-how-to-use-vba-to-update-a-sql-server-table-from-a-spreadsheet.html

Write Multiple Rows in EXCEL (VB) to SQL Table

Would like to be able to write all rows that have data in them to SQL table, with the below I can only export the 1st row. If I add more rows of data and click the Export Button I will only send the first row. Can some one help me script my request?
Sub Button1_Click()
Dim conn As ADODB.Connection
Dim cmd As ADODB.Command
Dim strSQL As String
strSQL = "INSERT INTO dbo.TimeLog" & _
"(EventDate, ID, DeptCode, Opcode, StartTime, FinishTime, Units) " & _
"VALUES (?,?,?,?,?,?,?);"
Set conn = New ADODB.Connection
conn.Open "Provider=SQLOLEDB;Data Source=db\db1;Initial Catalog=Table1;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 EventDate
Do Until .Cells(iRowNo, 1) = ""
cmd.Parameters.Append _
cmd.CreateParameter("pEventDate", adVarChar, adParamInput, 8, .Cells(iRowNo, 1))
cmd.Parameters.Append _
cmd.CreateParameter("pID", adInteger, adParamInput, , .Cells(iRowNo, 2))
cmd.Parameters.Append _
cmd.CreateParameter("pDeptCode", adVarChar, adParamInput, 2, .Cells(iRowNo, 3))
cmd.Parameters.Append _
cmd.CreateParameter("pOpCode", adVarChar, adParamInput, 2, .Cells(iRowNo, 4))
cmd.Parameters.Append _
cmd.CreateParameter("pStartTime", adDBTime, adParamInput, 0, .Cells(iRowNo, 5))
cmd.Parameters.Append _
cmd.CreateParameter("pFinishTime", adDBTime, adParamInput, 0, .Cells(iRowNo, 6))
cmd.Parameters.Append _
cmd.CreateParameter("pUnits", adInteger, adParamInput, , .Cells(iRowNo, 7))
cmd.Execute
iRowNo = iRowNo + 20
Loop
MsgBox "Success!"
End With
conn.Close
Set conn = Nothing
End Sub

Export Excel to SQL using VBA

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
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.
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/
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
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

Resources