I try to import date/time from Excel with VBA into SQL:
Here is my code :
Order = CDbl(row.Cells(1).Value)
PlanProductionTime = CDbl(row.Cells(2).Value)
Cavity = CDbl(row.Cells(3).Value)
Toynum = row.Cells(4).Value
STD = CDbl(row.Cells(5).Value)
DT = row.Cells(6).Value 'it's date/time data from exel
Sql = "insert into STDCT values(" & Order & "," & PlanProductionTime & "," & Cavity & ",'" & Toynum & "'," & STD & ",'" & DT & "')"
Sql2 = "delete STDCT where [Order] = '0'"
con.Execute Sql
con.Execute Sql2
Related
I'm trying to export some tables from EXCEL 2013 to my SQL Server 2017 Database via VBA ADO. All works fine, except when the datetime cell contains an empty value and then I get an exception. I tried to replace the values with NULL, 1900-01-01, '',((0)) but I always get SYSTEM ERROR &H80040E07
NUM_COURIER = rg.Cells(i, 3)
DATE_DEPART = rg.Cells(i, 4) 'DATETIME
DATE_RECEPTION = rg.Cells(i, 5) 'DATETIME
If DATE_DEPART = "" Then DATE_DEPART = "''" Else DATE_DEPART = "'" & DATE_DEPART & "'"
If DATE_RECEPTION = "" Then DATE_RECEPTION = "''" Else DATE_RECEPTION = "'" & DATE_RECEPTION & "'"
StrQuery = "INSERT INTO COURIER (NUM_COURIER_BANQUE,DATE_DEPART_BANQUE,DATE_RECEPTION_BANQUE) VALUES('" & NUM_COURIER & "'," & DATE_DEPART & "," & DATE_RECEPTION & ")"
Set rs = query(conn, StrQuery)
I am opening an SQL Server Connection in EXCEL VBA and on the objMyCmd.Execute line when it is using the SQL script I am getting this error message:
"Run-time error '-2147217900 (80040e14)') Automation error"
I have reviewed other SO posts that seem to reference an issue with the connection string itself, but I don't believe that is the issue as I am able to pull the first few variables listed when eliminating the rest of the SQL script.
I have attempted to review the SQL code to see if I am using an incorrect format, or if the language is not written properly and I am not able to determine the issue. I am hoping with some Q & A we may notice something I have missed in how this is written? Please let me know if there is additional information I can provide, below is the code up to the point of error.
Sub SQL_GetAgentChart()
Dim dtDate As Date
Dim myTable As ListObject
Dim DataServer As String
Dim Database As String
Dim constring As String
DataServer = "GLSSQLMADP2"
Database = "PERF_MGMT_BWRSRV_PROD"
constring = "Driver={SQL Server};Server=" & DataServer & "; Database=" & Database & "; Trusted_Connection=yes"
Dim AVStartDate As Date
Dim AVEndDate As Date
Dim RepID As Long
'Declare variables'
Set objMyConn = New ADODB.Connection
Set objMyCmd = New ADODB.Command
Set objMyRecordset = New ADODB.Recordset
Set myTable = Worksheets("Witness").ListObjects("tblWitness")
AVStartDate = DateValue("Mar 01, 2016")
AVEndDate = DateValue("Mar 31, 2016")
RepID = 2040
'Open Connection'
objMyConn.ConnectionString = constring
objMyConn.Open
'Set and Excecute SQL Command'
Set objMyCmd.ActiveConnection = objMyConn
objMyCmd.CommandText = " " & _
"SELECT PERSN_XTRNL_ID_NR, SOURCE, LOGGINGTS, DD7, CUREREASON, CUREDATE, LNSTATUS " & _
"FROM TTB " & _
"WITH INCALL AS (SELECT T.CUREREASON, CUREVALUE " & _
"FROM TTB T " & _
"JOIN PERSONNEL P ON T.PERSONNELID = P.PERSONNELID " & _
"LEFT JOIN CURETRANSLATE C ON T.CUREREASON = C.CUREREASON AND T.LNSTATUS = C.STATUS " & _
"WHERE T.PERSONNELID = " & RepID & " " & _
"AND LOGGINGTS > '" & AVStartDate & "' " & _
"AND LOGGINGTS < '" & AVEndDate + 1 & "' " & _
"AND INCOMING = 1 " & _
"AND DD7 > 0), OUTCALL AS (SELECT T.CUREREASON, CUREVALUE " & _
"FROM TTB T " & _
"JOIN AVAYA A ON T.UID = A.TTBUID " & _
"LEFT JOIN CURETRANSLATE C ON T.CUREREASON = C.CUREREASON AND T.LNSTATUS = C.STATUS " & _
"WHERE PERSONNELID = " & RepID & " " & _
"AND LOGGINGTS > '" & AVStartDate & "' " & _
"AND LOGGINGTS < '" & AVEndDate + 1 & "' " & _
"AND INCOMING = 0 " & _
"AND A.AVAYAGROUP IN ('15', '1A', '1B', '1C', '1D', '1E', '1F', '1G', '1H') " & _
"AND DD7 > 0) "
objMyCmd.CommandType = adCmdText
objMyCmd.Execute
Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 7 years ago.
Improve this question
I used the DATA-From Other Sources-From SQL Server controls to import a database table into my Excel workbook. It looks perfect, and refreshing data works like a charm.
However, whenever I make any changes to the table (editing, inserting or deleting rows), I cannot seem to find a way to push these changes to the database. This makes me wonder whether this is actually possible.
Can anybody tell me how to do this, or confirm that this is not supported?
When you make a 'live' table in Excel by linking to an external data source like you have described in this question, Excel manages this by using a QueryTable object behind the scenes.
QueryTable objects have the ability to be refreshed on demand, and to refresh on a periodic schedule defined by the user.
QuertyTable objects are NOT bi-directional. They can be used to import data into Excel, but not to write changes back to the data source.
QueryTable objects can be manipulated from VBA.
Custom VBA code can be written to automatically write to a data source any changes made by a user to a table. But this absolutely requires writing code... it is not a simple option that you can select from the Excel user interface for your table.
Can anybody tell me how to do this, or confirm that this is not supported?
Insert, update, and delete are not supported from the Excel user interface.
Since you didn't have an exact goal other than ,.. Can you, how to ? let me just dump my code that i KNOW works because i use it all the time. This is part of a custom ribbon that is on 20+ computer so they can update/merge their sales information into out database. This should help you out feel free to ask some questions. Basically how it works is creates SQL command, that creates a temp table then merge/updates against our database
Dim adoCN As ADODB.Connection
Dim sConnString As String
Dim sSQL, sSQLMerge As String
Dim Starting As Integer
''Find the starting point
For I = 1 To UBound(data, 2) - 1
If data(I, 0) <> "" Then
Starting = I
Exit For
End If
Next
'''This primes the temp table
'' into #tempTable " & vbCrLf
If LCase(CStr(data(Starting, 0))) = "null" Then
Else
sSQL = "select '" & replace(CStr(data(Starting, 0)), "'", "''") & "' as '" & _
replace(CStr(data(0, 0)), "'", "''") & "'"
End If
For I = 1 To UBound(data, 2) - 1
If LCase(replace(CStr(data(Starting, I)), "'", "''")) = "null" Then
sSQL = sSQL & ", '' as '" & _
replace(CStr(data(0, I)), "'", "''") & "'"
Else
sSQL = sSQL & ", '" & replace(CStr(data(Starting, I)), "'", "''") & "' as '" & _
replace(CStr(data(0, I)), "'", "''") & "'"
End If
Next
sSQL = sSQL & ", getdate() as 'UpdateDate', suser_sname() as 'UpdatedBy' into #tempTable " & vbCrLf
' this adds all the data to the temp table
For I = Starting + 1 To UBound(data, 1)
If replace(CStr(data(I, 0)), "'", "''") = "" Then 'Checks to see ifs it has prop id, if not skip
Else
If LCase(replace(CStr(data(I, 0)), "'", "''")) = "null" Then 'checks to see if null if so add blank
sSQL = sSQL & "union Select ''"
Else
sSQL = sSQL & "union Select '" & replace(CStr(data(I, 0)), "'", "''") & "'" 'if not null add value
End If
For II = 1 To UBound(data, 2) - 1
If LCase(replace(CStr(data(I, II)), "'", "''")) = "null" Then
sSQL = sSQL & ", ''"
Else
sSQL = sSQL & ", '" & replace(CStr(data(I, II)), "'", "''") & "'"
End If
Next
sSQL = sSQL & ", getdate(), suser_sname() " & vbCrLf
End If
Next
'GuidanceInputForm.SellerConditioning.Text = sSQL
''UserForm1.Label1.Caption = Len(sSQLMerge)
'GuidanceInputForm.Show
''Add Merge code
sSQLMerge = "Merge CommercialSandbox..MasterDataTape as t" & vbCrLf & _
" Using #temptable as S on (replace(t.[Property ID], '-','') = replace(s.[Property ID], '-','') and replace(t.[Event ID], '-','') = replace(s.[Event ID], '-','')) " & vbCrLf & _
" When NOT MATCHED BY TARGET THEN INSERT([" & data(0, 0) & "]"
For I = 1 To UBound(data, 2) - 1
sSQLMerge = sSQLMerge & ", [" & data(0, I) & "]"
Next
sSQLMerge = sSQLMerge & ", UpdateDate, UpdatedBy"
sSQLMerge = sSQLMerge & ") VALUES (s.[" & data(0, 0) & "]"
For I = 1 To UBound(data, 2) - 1
sSQLMerge = sSQLMerge & ", s.[" & data(0, I) & "]"
Next
sSQLMerge = sSQLMerge & ", s.UpdateDate, s.UpdatedBy"
sSQLMerge = sSQLMerge & ") " & vbCrLf & _
" When MATCHED THEN UPDATE SET t.[" & data(0, 0) & "] = s.[" & data(0, 0) & "]"
For I = 1 To UBound(data, 2) - 1
sSQLMerge = sSQLMerge & ", t.[" & data(0, I) & "] = s.[" & data(0, I) & "]"
Next
sSQLMerge = sSQLMerge & ", t.UpdateDate = s.UpdateDate, t.UpdatedBy = s.UpdatedBy"
sSQLMerge = sSQLMerge & ";"
'GuidanceInputForm.SellerConditioning.Text = sSQLMerge
''UserForm1.Label1.Caption = Len(sSQLMerge)
'GuidanceInputForm.Show
sConnString = "Provider=sqloledb;Server=ERPT01LAX01US.prod.auction.local\EDWALT;Database=Commercialsandbox;Integrated Security = SSPI"
Set adoCN = CreateObject("ADODB.Connection")
adoCN.CommandTimeout = 0
adoCN.Open sConnString
adoCN.Execute sSQL
adoCN.Execute sSQLMerge
adoCN.Close
If cell.Value <> "" Then
uid = cell
lname = Left(Replace(Range(cell.Address).Offset(0, 1), "'", ""), 50)
fname = Replace(Range(cell.Address).Offset(0, 2), "'", "")
stat = Replace(Range(cell.Address).Offset(0, 3), "'", "")
role = Left(Replace(Range(cell.Address).Offset(0, 4), "'", ""), 50)
iqn = Replace(Range(cell.Address).Offset(0, 5), "'", "")
sdate = Format(Replace(Range(cell.Address).Offset(0, 6), "'", ""), "yyyy-mm-dd")
bdate = Format(Replace(Range(cell.Address).Offset(0, 7), "'", ""), "yyyy-mm-dd")
rodate = Format(Replace(Range(cell.Address).Offset(0, 8), "'", ""), "yyyy-mm-dd")
End If
hirereason = Replace(Range(cell.Address).Offset(0, 9), "'", "")
roreason = Replace(Range(cell.Address).Offset(0, 10), "'", "")
sql = "BEGIN TRAN IF EXISTS (SELECT * FROM " & TableName & " WITH (updlock, serializable)"
sql = sql & " WHERE UID = '" & uid & "')"
sql = sql & " BEGIN"
sql = sql & " UPDATE" & TableName
sql = sql & " SET LName='" & lname & "', FName='" & fname & "'"
sql = sql & ", Status='" & stat & "', Role='" & role & "'"
sql = sql & ", IQNRole='" & iqn & "', StartDate='" & sdate & "'"
sql = sql & ", BillableDate='" & bdate & "', RollOffDate='" & rodate & "'"
sql = sql & ", HireReason='" & hirereason & "', RollOffReason='" & roreason & "'"
sql = sql & " WHERE UID = '" & uid & "'"
sql = sql & " END"
sql = sql & " ELSE BEGIN"
sql = sql & " INSERT " & TableName & " (UID, LName, FName, Status, Role, IQNRole, StartDate"
sql = sql & ", BillableDate, RollOffDate, HireReason, RollOffReason)"
sql = sql & " VALUES('" & uid & "', '" & lname & "', '" & fname & "', '" & stat & "'"
sql = sql & ", '" & role & "', '" & iqn & "', '" & sdate & "', '" & bdate & "', '" & rodate & "'"
sql = sql & ", '" & hirereason & "', '" & roreason & "')"
sql = sql & " END COMMIT TRAN"
Cn.Execute (sql)
End If
I have some values and I'm formatting the date values which come is as string to date. If I run this as is it puts a default value for "" into the DB as 1900-1-1. I want the NULL values to actually stay in the DB and not be over-written. Furthermore I want them to update a cell with NULL if say it didn't use to be but now is.
I tried wrapping my value rodate in an IF statement and tried validating it against NULL, NOTHING, and EMPTY to say if it is one of these UPDATE DB with "NULL" but it doesn't do it. Date still comes out 1900-1-1. Any ideas?
Dim roDate
'...
'...
rodate = Trim(cell.Offset(0, 8).Value)
If len(rodate)=0 Then
rodate = null
else
rodate = "'" & Format(rodate, "yyyy-mm-dd") & "'"
end if
'....
'....
'note no single quote here around rodate
sql = sql & ", BillableDate='" & bdate & "', RollOffDate=" & rodate
'...
'...
I'm confused, not sure if I get this question right.
The only thing I understood from it is that you are struggling with saving a date as NULL in the database.
NULL and an empty string are not the same.
Try and see if this works:
dim vNull as variant
vNull = Null
if sDate = "" then
//Save vNull instead of Date
end if
I don't believe that you can capture NULL in a string datatype.
Edit
Perhaps stupid that I didn't think of this before, but instead of an empty string, can't you just put the string "NULL" in the query string?
I'm currently making an Excel function that connects to an SQL server and retrieves data as long as it matches the given criteria.
Public Function VehModelUnitsCount(VehModel As String, fran As String, Site As Integer, SaleType As String, StartDate, EndDate, New As Integer) As Variant
Application.Volatile
If adoCN Is Nothing Then Call SetUpConnection
Set adoRS = New ADODB.Recordset
EvoStartDate = Format(StartDate, "yyyy/mm/dd")
EvoEndDate = Format(EndDate, "yyyy/mm/dd")
strSQL = "SELECT COUNT(*) As RCOUNT FROM CARTYPES RIGHT OUTER JOIN CARS ON CARTYPES.Description = CARS.Type LEFT OUTER JOIN CARS2 ON CARS.[Stock Number] = CARS2.[Stock Number]" & Chr(13)
strSQL = strSQL & "WHERE (CARTYPES.NewSale = " & New & " )" & Chr(13)
strSQL = strSQL & "AND (CARTYPES.Franchise = '" & fran & "')" & Chr(13)
strSQL = strSQL & "AND (CARTYPES.Site = " & Site & ")" & Chr(13)
strSQL = strSQL & "AND (CARTYPES.SaleTypeDesc = '" & SaleType & "')" & Chr(13)
strSQL = strSQL & "AND (CARS2.InvoiceDate BETWEEN '" & StartDate & "' AND '" & EndDate & "')" & Chr(13)
strSQL = strSQL & "AND (CARS.Invoiced = '1')" & Chr(13)
Rem strSQL = strSQL & "AND (CARS.Model = '" & VehModel & "')" & Chr(13)
[THIS ONE] - strSQL = strSQL & "AND (CARS.Model CONTAINS '" & VehModel & "')" & Chr(13)
adoRS.Open strSQL, adoCN, adOpenForwardOnly, adLockReadOnly
VehModelUnitsCount = adoRS.Fields("RCOUNT").Value
adoRS.Close
End Function
The string marked with [THIS ONE] is the one I am struggling with, I need to find out whether or not the cell contains the given string, but apparently using 'CONTAINS' doesn't work.
Any help on completing this would be amazing.
Thank you.
You could try -
strSQL = strSQL & "AND (CARS.Model LIKE '%" & VehModel & "%')" & Chr(13)