I am connecting to a SQL table via an Excel VBA script using using SQL Server vs Windows Authentication as we're creating a generic update application to be used by several different users. If I log into SQL Server Management Studio with the generic ID/pswd and SQL Server Authentication, I can successfully insert and delete rows. When I use the VBA script, I receive an error indicating that the INSERT or DELETE permission was denied. The VBA script works successfully against the same table in a different schema, but fails going against this schema. I am assuming it's something in the SQL environment, as it seems like it's forced to Windows Authentication regardless of how I make the connection. Any help would be greatly appreciated.
Updates:
Thanks for the responses. I hope this additional information helps. We are on SQL Server 15.04102.2, and I am using SQL Server Authentication with a generic application ID and PSWD that has update permissions (my individual windows account only has select permissions)
As I indicated in my initial post, if I execute this code against one test environment, the DELETE and INSERT work perfectly. When I execute it against a different environment, the connection is made, but I get the permissions error on the DELETE and INSERT. If I use the exact same credentials and use SQL Server Authentication to go directly to that environment, I can successfully execute the DELETE and INSERT statements.
Here is the error I receive on the DELETE statement. A similar error is received on the INSERT statement if I bypass the delete for a new add.
Error -2147217911 (The DELETE permission was denied on the object
‘BCG_CGS_DETAILS’, database ‘xxxxxxcustom’, schema ‘dbo’.) in
procedure Export CGS to SQL. sSQL = delete dbo.BCG_CGS_DETAILS where
[CGSNUM]= ‘CGS-xxxxx’ AND [PDPD_ID]= ‘xxxxx’ AND EFF_DT=’7/1/2021’
Here is the code I am executing.
Sub Export_CGS_to_SQL()
Dim cnn
Dim rst
Dim sSQL As String
Dim iRow As Integer
Dim sLINE, sCategory, sBCBSNC_Medical_Policy, sBCBSNC_Standard_Provisions As String
Dim sIn_Network_VALUE, sIn_Network_Type_of_payment, sIn_Network_Detail As String
Dim sOut_of_Network_VALUE, sOut_of_Network_Type_of_payment, sOut_of_Network_Detail As String
Dim sCustomized, sCGSNUM, sPDPD_ID, sEFF_DT As String
Dim lLastrow As Long
Dim sServer, sTable, sDatabase, sConnection As String
On Error GoTo errHandler
With Sheets("CGS Data")
sCGSNUM = .Cells(2, 12)
sPDPD_ID = .Cells(2, 13)
sEFF_DT = .Cells(2, 14)
If sCGSNUM = "" Or sPDPD_ID = "0" Or sEFF_DT = "" Then
MsgBox "One or more required fields is blank. Please make sure that the Product ID and Effective date are set correctly on the MISC tab, and that the CGS Number exists for row A06c on the Client Profile tab"
Exit Sub
End If
lLastrow = Cells(Rows.Count, 1).End(xlUp).Row
sServer = Worksheets("MACRO_DATA").Range("B6").Value
sTable = Worksheets("MACRO_DATA").Range("B7").Value
sDatabase = Worksheets("MACRO_DATA").Range("B8").Value
sConnection = Worksheets("MACRO_DATA").Range("F5").Value
'Create a new Connection object
Set cnn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
If cnn.State <> 1 Then
sSQL = "Provider=SQLOLEDB;Data Source=" & sServer & "; Initial Catalog=" & sDatabase & ";" & sConnection & "; Trusted_Connection=yes"
cnn.Open (sSQL)
End If
Set rst.ActiveConnection = cnn
sSQL = "delete " & sTable & " where [CGSNUM]= '" & sCGSNUM & "' AND [PDPD_ID]= '" & sPDPD_ID & "' AND EFF_DT= '" & sEFF_DT & "'"
cnn.Execute sSQL
For iRow = 2 To lLastrow
sLINE = .Cells(iRow, 1)
If sLINE <> "" Then
sCategory = .Cells(iRow, 2)
sBCBSNC_Medical_Policy = .Cells(iRow, 3)
sBCBSNC_Standard_Provisions = .Cells(iRow, 4)
sIn_Network_VALUE = .Cells(iRow, 5)
sIn_Network_Type_of_payment = .Cells(iRow, 6)
sIn_Network_Detail = .Cells(iRow, 7)
sOut_of_Network_VALUE = .Cells(iRow, 8)
sOut_of_Network_Type_of_payment = .Cells(iRow, 9)
sOut_of_Network_Detail = .Cells(iRow, 10)
sCustomized = .Cells(iRow, 11)
sCGSNUM = .Cells(iRow, 12)
sPDPD_ID = .Cells(iRow, 13)
sEFF_DT = .Cells(iRow, 14)
'insert row into sDatabase
sSQL = "insert into " & sTable & "([LINE],[Category],[BCBSNC Medical Policy],[BCBSNC Standard Provisions],[In-Network_VALUE]," _
& "[In-Network_Type of payment],[In-Network Detail],[Out-of-Network_VALUE],[Out-of-Network_Type of payment],[Out-of-Network_Detail]," _
& "[Customized],[CGSNUM],[PDPD_ID],[EFF_DT])" _
& "values ('" & sLINE & "', '" & sCategory & "', '" & sBCBSNC_Medical_Policy & "', '" & sBCBSNC_Standard_Provisions & "', '" _
& sIn_Network_VALUE & "', '" & sIn_Network_Type_of_payment & "', '" & sIn_Network_Detail & "', '" & sOut_of_Network_VALUE & "', '" _
& sOut_of_Network_Type_of_payment & "', '" & sOut_of_Network_Detail & "', '" & sCustomized & "', '" & sCGSNUM & "', '" _
& sPDPD_ID & "', '" & sEFF_DT & "')"
cnn.Execute sSQL
End If
Next iRow
MsgBox "CGS Data successfully exported to " & sTable, vbInformation
cnn.Close
Set cnn = Nothing
End With
Exit Sub
errHandler:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Export CGS to SQL. sSQL = " & sSQL
cnn.Close
Set cnn = Nothing
End Sub
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
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
I have 4 tables: Code_Product, Name_Product, Color_Product, Size_Product
And code:
Public Sub ExecuteQuery(query As String)
Dim command As New SqlCommand(query, connection)
command.ExecuteNonQuery()
End Sub
Private Sub btnUpdate_Click(sender As Object, e As EventArgs) Handles btnUpdate.Click
Dim updateQuery As String = "UPDATE tbl_Product SET Name_Product = '" & txtNameProduct.Text & "' , Color_Product = '" & txtColorProduct.Text & "', Size_Product = '" & txtSizeProduct.Text & "' where Kode_Produk= '" & txtKodeProduk.Text & "'"
ExecuteQuery(updateQuery)
MessageBox.Show("Data has been changed")
Notes: the code work.
But, the code changes all columns, and I just want to change only one column. How?
replace this line
Dim updateQuery As String = "UPDATE tbl_Product SET Name_Product = '" & txtNameProduct.Text & "' , Color_Product = '" & txtColorProduct.Text & "', Size_Product = '" & txtSizeProduct.Text & "' where Kode_Produk= '" & txtKodeProduk.Text & "'"
with this. Pass only that column which you want to update.
Dim updateQuery As String = "UPDATE tbl_Product SET Name_Product = '" & txtNameProduct.Text & "' where Kode_Produk= '" & txtKodeProduk.Text & "'"
this is my code
dim straccess as string
Do While Not rso.EOF
30 straccess = "INSERT INTO [test] ([nik],[nama]) VALUES ('" & rso.Fields(0)
& "' ,'" & rso.Fields(1) & "' ) where [nama]= '" _
& rso.Fields(0) & "';"
cna.Execute straccess
Loop
got error on line 30 when insert data.
im type this code in vb6 n want to insert data from oracle database/table to msaccess database/table. i already hv connection to oracle table n ms access. And now I try to insert data into MS Access table based data in oracle table
my table name in ms access is TEST and my table name in empmasterepms.
this is my all code .
Dim vstr As String
Dim filename As String
Dim straccess As String
Option Explicit
Const ORACLEQUERY As String = "select empcode,empname from empmasterepms order by EMPNAME"
Dim cno As New ADODB.Connection
Dim cna As New ADODB.Connection
Dim rso As New ADODB.Recordset
Dim rsa As New ADODB.Recordset
Private Sub btnload_Click()
On Error GoTo Error_Handler
'-----------------Connection to Oracle
cno.Open "Provider=msdaora;Data Source=192.168.0.15:1521/EPMS;User Id=EPMS_TRXI;Password=epmse292014;"
rso.CursorType = adOpenStatic
rso.CursorLocation = adUseClient
rso.LockType = adLockOptimistic
rso.Open ORACLEQUERY, cno, , , adCmdText
Set dg1.DataSource = rso
------- connect to msaccess
cna.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & vstr
rso.MoveFirst
Do While Not rso.EOF
30 straccess = "Update test SET [nik] = '" & rso.Fields(0).Value & "' ,[nama] = '" & rso.Fields(1).Value & "' WHERE [nama] = '" & rso.Fields(1).Value & "';"
cna.Execute straccess
rso.MoveNext
Loop
MsgBox "Done"
cno.Close
Set cno = Nothing
Set cna = Nothing
Exit Sub
Error_Handler:
MsgBox Erl & ":" & Err.Number & ":" & Err.Description
Debug.Print (straccess)
end sub
Remove the Where statement:
30 straccess = "INSERT INTO [test] ([nik],[nama]) VALUES ('" & rso.Fields(0).Value & "','" & rso.Fields(1).Value & "');"