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
Related
I am new in VBA via Outlook, so ...
I use Outlook 2016, and SQL Server 2017, and I try to connect a macro to SQL Server Express 2017 via ADODB.
Here is my code
On Error GoTo ErrorHandler
Dim cnnStr As String
cnnStr = "Provider=SQLOLEDB;" & _
"Server=ALTROISIEME\SQLEXPRESS;" & _
"Initial Catalog=XX_Options;" & _
"Trusted_Connection=SSPI;" & _
"uid=xxxx;" & _
"pwd=xxxxxx;"
'GoTo Fin_99
Dim cnn As New ADODB.Connection
cnn.CommandTimeout = 900
cnn.ConnectionString = cnnStr
cnn.Open
GoTo Fin_99
Dim cmd As ADODB.Command
Set cmd.ActiveConnection = cnn
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "USP_Outlook_Add_File_Data"
cmd.Parameters.Append cmd.CreateParameter("#Categorie", adVarWChar, adParamInput, , "IB_DailyTrade")
cmd.Parameters.Append cmd.CreateParameter("#NomDuFichier", adVarWChar, adParamInput, , FileNameExt)
cmd.Parameters.Append cmd.CreateParameter("#Donnee", adVarWChar, adParamInput, , HTMLTxt)
Dim rst As New ADODB.Recordset
rst.CursorType = adOpenStatic
rst.CursorLocation = adUseClient
rst.LockType = adLockOptimistic
rst.Open cmd
Set rst = cmd.Execute
ExitNewItem:
GoTo Fin_99
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ExitNewItem
Fin_99:
On Error GoTo CloseRst
cnn.Close
Set cnn = Nothing
CloseRst:
rst.Close
Set rst = Nothing
The macro throws an error on line
Set cmd.ActiveConnection = Cnn
with a message.
91-Variable object or variable of block not defined
Could you help?
Thank you
André
I found all my issues. The code is not so far from my initial post:
On Error GoTo ErrorHandler
Dim cnnStr As String
cnnStr = "Provider=SQLOLEDB;" & _
"Server=?????????\SQLEXPRESS;" & _
"Initial Catalog=???????;" & _
"Trusted_Connection=SSPI;" & _
"uid=???;" & _
"pwd=???;"
Dim cnn As New ADODB.Connection
Set cnn = New ADODB.Connection
cnn.CommandTimeout = 900
cnn.ConnectionString = cnnStr
cnn.Open
Dim cmd As ADODB.Command
Set cmd = New ADODB.Command
cmd.ActiveConnection = cnn
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "USP_Outlook_Add_File_Data"
cmd.Parameters.Append cmd.CreateParameter("#Categorie", adVarWChar, adParamInput, 50, "IB_DailyTrade")
cmd.Parameters.Append cmd.CreateParameter("#NomDuFichier", adLongVarWChar, adParamInput, -1, FileNameExt)
cmd.Parameters.Append cmd.CreateParameter("#Donnee", adLongVarWChar, adParamInput, -1, HTMLTxt)
Dim rst As New ADODB.Recordset
Set rst = New ADODB.Recordset
rst.CursorType = adOpenStatic
rst.CursorLocation = adUseClient
rst.LockType = adLockOptimistic
rst.Open cmd
Set rst = cmd.Execute
ExitNewItem:
GoTo Fin_99
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ExitNewItem
Fin_99:
If cnn.State = 1 Then
cnn.Close
Set cnn = Nothing
End If
If rst.State = 1 Then
rst.Close
Set rst = Nothing
End If
So, I am currently working on an app where I need to call a stored procedure that takes a User defined table as a parameter. In .NET I am able to just pass the data in a datatable, but in MS Access VBA I am having difficulty passing an ADO recordset to the stored procedure as the user defined table.
Private Sub DeleteRecords()
On Error GoTo Err_DeleteRecords
Dim cnn As ADODB.Connection, cmd As New ADODB.Command, param As New ADODB.Parameter
Dim i As Integer
Dim rs As ADODB.Recordset
Dim text As String
Dim gs As String
Set cnn = CurrentProject.Connection
gs = "DECLARE #StagingRecsToDelete StagingRecsToDelete_UDT; SELECT * FROM #StagingRecsToDelete"
Set rs = New ADODB.Recordset
rs.Open gs, cnn, adOpenKeyset, adLockOptimistic
If rs.RecordCount = 0 Then
For i = 0 To Me.lstFingerPrintServiceStaging.ListCount - 1
If Me.lstFingerPrintServiceStaging.Selected(i) Then
text = text + Me.lstFingerPrintServiceStaging.Column(0, i)
rs.AddNew
rs!intFingerPrintServiceStagingID = text
End If
Next i
End If
If rs.RecordCount > 0 Then
Set cmd = New ADODB.Command
cmd.ActiveConnection = cnn
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "dbo.SPFingerPrintDeleteErrors"
Set param = cmd.CreateParameter("#ReturnValue", adInteger, adParamReturnValue)
cmd.Parameters.Append param
Set param = cmd.CreateParameter("StagingRecsToDelete_UDT", adVarient, adParamInput, , rs)
cmd.Parameters.Append param
Set param = cmd.CreateParameter("#ErrNbr", adInteger, adParamOutput)
cmd.Parameters.Append param
Set param = cmd.CreateParameter("#ErrMsg", adVarChar, adParamOutput, 8000)
cmd.Parameters.Append param
cmd.Execute
End If
Select Case cmd.Parameters("#ReturnValue").Value
Case 1 'System error
MsgBox cmd.Parameters("#ErrMsg").Value, vbOKOnly + vbInformation, gApplicationTitle
Exit Sub
Case 0 'Succeeds
MsgBox "The Selected records have been successfully deleted.", vbOKOnly + vbInformation, gApplicationTitle
Case -1 'User Error
MsgBox cmd.Parameters("#ErrMsg").Value, vbOKOnly + vbInformation, gApplicationTitle
Exit Sub
End Select
cnn.Close
Set cnn = Nothing
Exit_DeleteRecords:
Exit Sub
Err_DeleteRecords:
MsgBox "Form=" & Me.Name & ", Function=DeleteRecords" & vbCrLf & "Err#=" &
Err & " " & Error$
Resume Exit_DeleteRecords
End Sub
For the most part, all of it works, but I do not know what datatype to set the UDT to when I pass it to the stored procedure.
The MS Access (DAO) does not support it.
You can create an XML with your data and pass it as SP param or insert it into a temporary table one by one fisrt.
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
I am trying to debug Excel VBA code that is calling a stored procedure resident on our SQL Server (SQL Server 2008 R2). With a bit of error trapping I can now see what the error is but I have no idea what is causing it.
Here is my VBA code:
Sub Add_Results_Of_ADO_Recordset()
Dim cnt As ADODB.Connection
Dim rst As ADODB.Recordset
Dim cmd As ADODB.Command
Dim stSQL As String
Const stADO As String = "Provider=SQLOLEDB.1;User ID =xxxxx;Password=xxxxx;" & _
"Persist Security Info=False;" & _
"Initial Catalog=MyDatabase;" & _
"Data Source=xxxxxxxxxxxx"
' initialise ADO
Set cnt = New ADODB.Connection
cnt.Open stADO
On Error GoTo Err_SaveProposal
Set cmd = New ADODB.Command
With cmd
.ActiveConnection = cnt
.CommandText = "PolicyList"
.CommandType = adCmdStoredProc
.NamedParameters = True
.Parameters.Refresh
.Parameters.Append .CreateParameter("#Incept", adVarChar, adParamInput, 10, "2/1/2014")
.Parameters.Append .CreateParameter("#Expire", adVarChar, adParamInput, 10, "2/1/2014")
.Parameters.Append .CreateParameter("#PStatus", adVarChar, adParamInput, 20, "BOOK")
End With
' Debug code to ensure parameters are set correctly
For Each prm In cmd.Parameters
Debug.Print prm.Name & " : " & prm.Value
Next
cmd.Execute
If cnt.State = adStateOpen Then cnt.Close
Exit Sub
Err_SaveProposal:
Debug.Print Err.Number & ": " & Err.Description
If cnt.State = adStateOpen Then cnt.Close
End Sub
Here are the messages written to the immediate window:
#RETURN_VALUE :
#Incept :
#Expire :
#PStatus :
#Incept : 2/1/2014
#Expire : 2/1/2014
#PStatus : BOOK
-2147217900: Procedure or function PolicyList has too many arguments specified.
It looks like the three arguments I am trying to send to the stored procedure are being sent twice. Once as empty strings and one with the values I want to send. Any suggestions?
I've set up a Stored Procedure in SQL Server that works fine. I can now call it from VBA, but want to return a value to know if there were any errors etc. The last parameter in my SP is set up as OUTPUT:
#DataSetID int = 0,
#Destination char(1)='-',
#errStatusOK bit OUTPUT
My VBA to call the SP is below, but it won't work now, after adding the new parameter and I'm not sure where I'm going wrong, I keep getting 3708 - Parameter object is improperly defined. Inconsistent or incomplete information was provided.:
Set cnn = New adodb.Connection
cnn.ConnectionString =
"DRIVER=SQL Server;SERVER=SERVER\SERVER;DATABASE=a_db;Trusted_Connection=Yes"
cnn.Open cnn.ConnectionString
Set cmd = New adodb.Command
cmd.ActiveConnection = cnn
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "stprMoveDataSet"
Set param = cmd.CreateParameter
("#DataSetID", adInteger, adParamInput, , stDataSet)
cmd.Parameters.Append param
Set param = cmd.CreateParameter
("#Destination", adChar, adParamInput, 1, stDestination)
cmd.Parameters.Append param
Set param = cmd.CreateParameter
("#errStatusOK", adBit, adParamReturnValue)
cmd.Parameters.Append param
rs.CursorType = adOpenStatic
rs.CursorLocation = adUseClient
rs.LockType = adLockOptimistic
rs.Open cmd
How can I get the vba to work with the OUTPUT parameter and make the return value 'readable' by the vba.
EDIT - I've changed the question to be more specifically about returning values and not just about using OUTPUT Parameters.
Several ways are possible to get values back using VBA.
Recordset
Count of records affected (only for Insert/Update/Delete otherwise -1)
Output parameter
Return value
My code demonstrates all four. Here is a stored procedure that returns a value:
Create PROCEDURE CheckExpedite
#InputX varchar(10),
#InputY int,
#HasExpedite int out
AS
BEGIN
Select #HasExpedite = 9 from <Table>
where Column2 = #InputX and Column3 = #InputY
If #HasExpedite = 9
Return 2
Else
Return 3
End
Here is the sub I use in Excel VBA. You'll need reference to Microsoft ActiveX Data Objects 2.8 Library.
Sub CheckValue()
Dim InputX As String: InputX = "6000"
Dim InputY As Integer: InputY = 2014
'open connnection
Dim ACon As New Connection
'ACon.Open ("Provider=SQLOLEDB;Data Source=<SqlServer>;" & _
' "Initial Catalog=<Table>;Integrated Security=SSPI")
'set command
Dim ACmd As New Command
Set ACmd.ActiveConnection = ACon
ACmd.CommandText = "CheckExpedite"
ACmd.CommandType = adCmdStoredProc
'Return value must be first parameter else you'll get error from too many parameters
'Procedure or function "Name" has too many arguments specified.
ACmd.Parameters.Append ACmd.CreateParameter("ReturnValue", adInteger, adParamReturnValue)
ACmd.Parameters.Append ACmd.CreateParameter("InputX", adVarChar, adParamInput, 10, InputX)
ACmd.Parameters.Append ACmd.CreateParameter("InputY", adInteger, adParamInput, 6, InputY)
ACmd.Parameters.Append ACmd.CreateParameter("HasExpedite", adInteger, adParamOutput)
Dim RS As Recordset
Dim RecordsAffected As Long
'execute query that returns value
Call ACmd.Execute(RecordsAffected:=RecordsAffected, Options:=adExecuteNoRecords)
'execute query that returns recordset
'Set RS = ACmd.Execute(RecordsAffected:=RecordsAffected)
'get records affected, return value and output parameter
Debug.Print "Records affected: " & RecordsAffected
Debug.Print "Return value: " & ACmd.Parameters("ReturnValue")
Debug.Print "Output param: " & ACmd.Parameters("HasExpedite")
'use record set here
'...
'close
If Not RS Is Nothing Then RS.Close
ACon.Close
End Sub
Set cnn = New adodb.Connection
cnn.ConnectionString =
"DRIVER=SQL Server;SERVER=SERVER\SERVER;DATABASE=a_db;Trusted_Connection=Yes"
cnn.Open cnn.ConnectionString
Set cmd = New adodb.Command
cmd.ActiveConnection = cnn
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "stprMoveDataSet"
Set param1 = cmd.CreateParameter
("#DataSetID", adInteger, adParamInput, , stDataSet)
cmd.Parameters.Append param
Set param2 = cmd.CreateParameter
("#Destination", adChar, adParamInput, 1, stDestination)
cmd.Parameters.Append param
Set param3 = cmd.CreateParameter
("#errStatusOK", adBit, adParamOutput, , adParamReturnValue)
cmd.Parameters.Append param
rs.CursorType = adOpenStatic
rs.CursorLocation = adUseClient
rs.LockType = adLockOptimistic
rs.Open cmd
I'd initially looked at OUTPUT Parameters, but could not find out how to get them back to Access (in VBA) to then provide feedback to the user. A colleague suggested using a SELECT in the Stored procedure and to use this.
STORED PROCEDURE:
Added the following at the end:
SELECT #errStatusOK as errStatusOK, #countCurrent as countCurrent, #countHistorical as countHistorical
VBA:
Dim cnn As ADODB.Connection
Dim cmd As New ADODB.Command, rs As New ADODB.Recordset, param As New ADODB.Parameter
Dim fld As ADODB.Field
Dim stMessage As String
Set cnn = New ADODB.Connection
cnn.ConnectionString = "DRIVER=SQL Server;SERVER=SERVER\SERVER;DATABASE=a_db;Trusted_Connection=Yes"
cnn.Open cnn.ConnectionString
Set cmd = New ADODB.Command
cmd.ActiveConnection = cnn
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "stprMoveDataSet"
Set param = cmd.CreateParameter("#DataSetID", adInteger, adParamInput, , stDataSet)
cmd.Parameters.Append param
Set param = cmd.CreateParameter("#Destination", adChar, adParamInput, 1, stDestination)
cmd.Parameters.Append param
rs.CursorType = adOpenStatic
rs.CursorLocation = adUseClient
rs.LockType = adLockOptimistic
'rs.Open cmd
Set rs = cmd.Execute
If rs!errstatusok = True Then
stMessage = "Operation appears to have been successful, check the DataSets Listing..." & Chr(13) & "Also, the Server returned the following information: ["
Else
stMessage = "Operation appears to have failed, check the DataSets Listing..." & Chr(13) & "Also, the Server returned the following information: ["
End If
For Each fld In rs.Fields
stMessage = stMessage & "| " & fld.Name & " / " & fld.Value & " |"
Next fld
stMessage = stMessage & "]"
MsgBox stMessage
This returns the folliwing:
Operation appears to have failed, check the DataSets Listing...
Also, the Server returned the following information: [| errStatusOK / False || countCurrent / 0 || countHistorical / 10 |]
Among the other parameter enumerations from which "adParamInput" is taken, another is "adParamOutput", which is to indicate an out parameter from a stored procedure, and "adParamInputOutput" for a parameter which goes "both directions," as it were. In your case, I believe "adParamOutput" would be appropriate. I hope this is what you're looking for.