My excel-sheet is connected with the data of the sql-server. My clients shall be able to write some columns back to the sql server. The excel-filenames are variable, but the sheeetname and the columns are always static. I tried it with a button and vba but it ends up in error:
Syntaxerror (missing operator) in queryexpression 'UPDATE hbs SET lieferinfo_prio_neu = xlsx.liefer_prio_neu FROM [Provider=SQLOLEDB;Data Source=myserver;Database=mydb;UID=myuser;PWD=mypass;].[tbl_haka_base_size] hbs JOIN [Tabelle3$] xlsx ON xlsx.Artikelnummer'
The internal excel-sheetname is 'Tabelle3', the custom-name is 'Hakabase':
I tried both names without any result.
My code:
Dim excelConn As String
Dim sqlServerConn As String
Dim sqlCommand As String
Dim conn As ADODB.Connection
excelConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
& ThisWorkbook.FullName _
& ";Extended Properties=""Excel 12.0 Xml;HDR=Yes;IMEX=1"";"
sqlServerConn = "[Provider=SQLOLEDB;" _
& "Data Source=myserver;" _
& "Database=mydb;" _
& "UID=ymuser;PWD=mypass;]"
sqlCommand = "UPDATE hbs " _
& " SET lieferinfo_prio_neu = xlsx.liefer_prio_neu " _
& " FROM " & sqlServerConn & ".[tbl_haka_base_size] hbs " _
& " JOIN [Tabelle3$] xlsx " _
& " ON xlsx.Artikelnummer=hbs.artikelnummer"
Set conn = New ADODB.Connection
conn.Open excelConn
conn.Execute sqlCommand
I've also tried to connect to the sqlserver + join the excel-data via openrowset but the server disallowed that:
& " JOIN OPENROWSET('MSDASQL', " _
& " 'Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" _
& ThisWorkbook.FullName & "', 'SELECT * FROM [Tabelle3$]') xlsx" _
Installable ISAM not found
I think I have to create a linked server for each file and enable 'InProcess' for those files. This is not possible because the files are variable.
I've found an alternative solution which is a little bit slow so I still hope someone else is able to answer my question.
The alternative solution is to iterate through each row.. The file got about 150.000 rows and just for 10.000 rows I am waiting about 10 minutes..
Here is the part of iterating
For Each range In sheet.rows: Do
'Continue on headline
If range.Row = 1 Or range.EntireRow.Hidden = True Then
Exit Do
End If
If Len(sheet.Cells(range.Row, lieferInfoColumnIndex)) > 0 Then
articleNumber = sheet.Cells(range.Row, artNoColumnIndex)
UpdateDatabase (articleNumber)
savings = savings + 1
End If
Loop While False: Next range
Here is the slow update function for each row:
Private Sub UpdateDatabase(articleNumber As String)
Dim sqlServerConn As String
Dim sqlCommand As String
Dim conn As ADODB.Connection
sqlServerConn = "Provider=SQLOLEDB;" _
& "Data Source=myserver;" _
& "Database=mydb;" _
& "UID=myuser;PWD=mypass;"
sqlCommand = "UPDATE hbs " _
& "SET lieferinfo_prio_neu=NULL " _
& "FROM [TBL_HAKA_BASE] hbs " _
& "WHERE Artikelnummer=" + articleNumber
Set conn = New ADODB.Connection
conn.Open sqlServerConn
conn.Execute sqlCommand
End Sub
Related
I am trying to use the following VBA code to run a select query in MS Access.
Private Sub ManuReport_Click()
Dim dbs As DAO.Database
Dim rsSQL As DAO.Recordset
Dim StrSQL As String
Set dbs = CurrentDb
strSQL = "SELECT " & _
"dbo_VENDOR1.ITEM_NO," & _
"dbo_VENDOR1.ITEM_PRICE," & _
"dbo_VENDOR2.ITEM_NO," & _
"dbo_VENDOR2.ITEM_PRICE," & _
"dbo_VENDOR1.MANUFACTURER_ITEM_NO," & _
"dbo_VENDOR1.MANUFACTURER," & _
"dbo_VENDOR1.ITEM_NAME " & _
"From dbo_VENDOR2 " & _
"INNER JOIN dbo_VENDOR1 " & _
"ON dbo_VENDOR2.MANUFACTURER_ITEM_NO = dbo_VENDOR1.MANUFACTURER_ITEM_NO " & _
"WHERE dbo_VENDOR1.MANUFACTURER IN ('MANUFACTURER CODE') " & _
"And dbo_VENDOR1.ITEM_PRICE > dbo_VENDOR2.ITEM_PRICE "
Set rsSQL = dbs.OpenRecordset(strSQL, dbOpenDynaset)
End Sub
I have added this to a button in MSACCES to pull this information from a linked SQL database. I have also been having issues with adding references to form text boxes but I may submit that as a separate question. Whenever I press the button, nothing happens. I don't even get an error screen. I have seen other answers where the issue seems to be how the OpenRecordSet is being used but I am having trouble understanding how I can apply it to this code.
The query itself does work when I create a separate query in Access so I am not sure where the problem is. I reformatted the SQL portion of the code to make it easier to read here, but I have it formatted as a single line in the actual VBA code.
It looks like you want to open a query in Access for display based on a SQL string
The following function will create a query based on the SQL string
Function createQry(qryName As String, sSQL As String)
Dim qdf As QueryDef
' Delete existing query
On Error Resume Next
CurrentDb.QueryDefs.Delete (qryName)
On Error GoTo 0
Set qdf = CurrentDb.CreateQueryDef(qryName, sSQL)
End Function
If you use this code in your posted code like that
Private Sub ManuReport_Click()
Dim dbs As DAO.Database
Dim rsSQL As DAO.Recordset
Dim StrSQL As String
Set dbs = CurrentDb
StrSQL = "SELECT " & _
"dbo_VENDOR1.ITEM_NO," & _
"dbo_VENDOR1.ITEM_PRICE," & _
"dbo_VENDOR2.ITEM_NO," & _
"dbo_VENDOR2.ITEM_PRICE," & _
"dbo_VENDOR1.MANUFACTURER_ITEM_NO," & _
"dbo_VENDOR1.MANUFACTURER," & _
"dbo_VENDOR1.ITEM_NAME " & _
"From dbo_VENDOR2 " & _
"INNER JOIN dbo_VENDOR1 " & _
"ON dbo_VENDOR2.MANUFACTURER_ITEM_NO = dbo_VENDOR1.MANUFACTURER_ITEM_NO " & _
"WHERE dbo_VENDOR1.MANUFACTURER IN ('MANUFACTURER CODE') " & _
"And dbo_VENDOR1.ITEM_PRICE > dbo_VENDOR2.ITEM_PRICE "
'Set rsSQL = dbs.OpenRecordset(StrSQL, dbOpenDynaset)
Dim qryName As String
qryName = "qryTest"
' close the query in case it is open in Access
DoCmd.SetWarnings False
DoCmd.Close acQuery, qryName
DoCmd.SetWarnings True
' Create the query based on the SQL string
createQry qryName, StrSQL
' Open the query in Access for display
DoCmd.OpenQuery qryName, acNormal, acReadOnly
End Sub
I have the table and fields created on the SQL end. The debugger points to the cnn.Execute uSQL being the issue. I am trying to write the user and computer name of who is accessing the sheet to SQL.
Sub UpdateTable()
Dim cnn As ADODB.Connection
Dim uSQL As String
Dim strText As String
Dim strDate As Date
Dim strUsername As String
Dim strComputerName As String
strUsername = Environ("username")
strComputerName = Environ("Computername")
Set cnn = New Connection
cnnstr = "Provider=SQLOLEDB; " & _
"Data Source=icl-analive; " & _
"Initial Catalog=DW_ALL;" & _
"User ID=dw_all_readonlyuser;" & _
"Trusted_Connection=Yes;"
cnn.Open cnnstr
uSQL = "INSERT INTO Audit (UN,CN) VALUES StrUsername , strComputer"
Debug.Print uSQL
cnn.Execute uSQL
cnn.Close
Set cnn = Nothing
Exit Sub
End Sub
Your uSQL should be like this:
uSQL = "INSERT INTO Audit (UN,CN) VALUES " & StrUsername & "," & strComputer
Edit:
Actually like this:
INSERT INTO Audit (UN,CN) VALUES '" & StrUsername & "','" & strComputer & "'"
The difference is that we should set the strings in inverted commas for the SQL. Thanks #Tony Dong in the comments.
This answer is a classic example of a vulnerable code for SQL injection.In order to prevent it, consider using parameterized queries as in this example:
VBA, ADO.Connection and query parameters
In the below code, my second query will not insert into the SQL database, but the first one will update. I can copy the query (from the msgbox i added for testing) and paste it in SQL Server Management Studio, and it will execute fine. I also do not get any error messages back from SQL, though i'm not sure if that code is correct (it was copied + pasted from another source). Also, can i simplify the code to pass both queries at the same time?
Dim Conn As New System.Data.SqlClient.SqlConnection 'sql server datastream connection
Dim Cmd As New System.Data.SqlClient.SqlCommand 'sql command vars
Dim SqlQuery As String 'string var used to hold various SQL queries
Dim data As System.Data.SqlClient.SqlDataReader 'datareader object variable
Dim MVDataset As New DataSet
Dim MVDatatable As DataTable
Dim MVDatarow As DataRow
Private Sub MVUpdateButton_Click(sender As Object, e As EventArgs) Handles MVUpdateButton.Click
vbyn = MsgBox("Are you sure you want to update Tally Sheet Master Variables?" & vbCrLf & vbCrLf & "Changes to these variables will change the functionality of the Tally Sheet!", vbYesNo, )
Try
Select Case vbyn
Case vbNo
GoTo MVTableUpdateBypass
Case vbYes
'get new data from textboxes
Vers = TextBox1.Text
If TextBox2.Text = True Then
Testing = 1
Else
Testing = 0
End If
FlatFeeCharge = TextBox3.Text
PrepricingCharge = TextBox4.Text
SendMailAcct = TextBox5.Text
SendMailPW = TextBox6.Text
TestingEmail = TextBox7.Text
PrePricingEmail = TextBox8.Text
ImperataEmail = TextBox9.Text
'update existing active row to mark inactive
SqlQuery = "Update MasterVars set Active = 0 where PKEY = " & PKEY & ";"
MsgBox(SqlQuery)
If Conn.State = ConnectionState.Closed Then
Conn.ConnectionString = "Data Source=SQL01;Initial Catalog=TallySheet;Integrated Security=SSPI;"
End If
Conn.Open()
Dim MVDataAdapter As New SqlDataAdapter(SqlQuery, Conn)
Dim MVUpdateCommand As SqlCommand
MVUpdateCommand = New SqlCommand(SqlQuery)
MVDataAdapter.UpdateCommand = MVUpdateCommand
'insert new active row
SqlQuery = "Insert into MasterVars (Vers, Testing, FlatFeeCharge, PrePricingCharge, SendMailAcct, SendMailPW, TestingEmail, PrePricingEmail, ImperataEmail, DTS, UserName, Active) Values (" & "'" & Vers & "', " & Testing & ", '" & FlatFeeCharge & "'" & ", '" & PrepricingCharge & "'" & ", '" & SendMailAcct & "'" & ", '" & SendMailPW & "'" & ", '" & TestingEmail & "'" & ", '" & PrePricingEmail & "'" & ", '" & ImperataEmail & "'" & ", '" & Date.Now & "'," & "'QGDOMAIN\" & Environment.UserName & "'," & 1 & ");"
MsgBox(SqlQuery)
Dim MVInsertCommand As SqlCommand
MVInsertCommand = New SqlCommand(SqlQuery)
MVDataAdapter.InsertCommand = MVInsertCommand
MVDataAdapter.Fill(MVDataset, "MasterVars")
End Select
Catch ex As SqlException
Dim i As Integer
Dim errormessages As String
errormessages = ""
For i = 0 To ex.Errors.Count - 1
errormessages = errormessages & " " & ("Index #" & i.ToString() & ControlChars.NewLine _
& "Message: " & ex.Errors(i).Message & ControlChars.NewLine _
& "LineNumber: " & ex.Errors(i).LineNumber & ControlChars.NewLine _
& "Source: " & ex.Errors(i).Source & ControlChars.NewLine _
& "Procedure: " & ex.Errors(i).Procedure & ControlChars.NewLine)
Next i
Console.WriteLine(errorMessages.ToString())
End Try
'reload form with updated variables
Conn.Close()
Conn.Dispose()
MVTableUpdateBypass:
End Sub
The Fill method of the SqlDataAdapter executes the SelectCommand not the UpdateCommand or the InsertCommand. In any case these two commands (and the DeleteCommand) are executed when you call the Update method of the adapter.
Moreover the Update method runs the commands looking for rows changed/added/deleted in the DataTable/DataSet retrieved by the SelectCommand and works only for those rows.
But you don't need an SqlDataAdapter to execute your two queries. You should simply construct an SqlCommand with both texts separated by a semicolon and call ExecuteNonQuery
SqlQuery = "Update MasterVars set Active = 0 where PKEY = #key;" & _
"Insert into MasterVars (Vers, Testing, .....) VALUES (#p1, #o2, ....)"
Using Conn = New SqlConnection("Data Source=SQL01;......")
Using cmd = New SqlCommand(SqlQuery, Conn)
Conn.Open()
cmd.Parameters.Add("#key", SqlDbType.Int).Value = PKEY
cmd.Parameters.Add("#p1", SqlDbType.NVarChar).Value = vers
cmd.Parameters.Add("#p2", SqlDbType.Int).Value = testing
... and so on with other parameters ....
cmd.ExecuteNonQuery()
End Using
End Using
In this incomplete example (too many parameters to write down) I have concatenated the two sql texts in a single string and prepared it with parameter placeholders. Then I build the parameter collection with the exact datatypes required by your table and finally call ExecuteNonQuery to run everything on the database side.
Notice that is not needed to keep global objects like the connection or the command. It is always better to create a local variable, use and destroy it when done. In particular disposable objects like the connection and the command should always created in a Using block
I have the following code, which uploads data from access to a SQL Server table. The problem is it wont overwrite/replace the table when I try to update it. I get an error saying the table already exists. I need to either add some code to delete the table so the new one can be uploaded or a way to append the new/edited records to the table.
Public Function Update()
DoCmd.TransferDatabase _
acExport, _
"ODBC Database", _
"ODBC;" & _
"Driver={SQL Server Native Client 10.0};" & _
"Server=SERVER;" & _
"Database=DB;" & _
"UID=ID;" & _
"PWD=PW;", _
acTable, _
"CDData", _
"AC_CDData", _
False
End Function
So the AC_CDData table is the one that needs to be replaced
If you want to DROP the existing destination table before transferring the new one then the code would be more like this:
Option Compare Database
Option Explicit
Public Function TransferTableToSqlServer()
Dim cdb As dao.Database, qdf As dao.QueryDef
Dim err As dao.Error
Const DestinationTableName = "AC_CDData"
Const ConnectionString = _
"ODBC;" & _
"Driver={SQL Server Native Client 10.0};" & _
"Server=(local)\SQLEXPRESS;" & _
"Database=YourDatabaseName;" & _
"UID=YourSqlUserId;" & _
"PWD=YourSqlPassword;"
Set cdb = CurrentDb
Set qdf = cdb.CreateQueryDef("")
qdf.Connect = ConnectionString
qdf.sql = _
"IF EXISTS " & _
"(" & _
"SELECT * FROM INFORMATION_SCHEMA.TABLES " & _
"WHERE TABLE_NAME='" & DestinationTableName & " '" & _
") " & _
"DROP TABLE [" & DestinationTableName & "]"
qdf.ReturnsRecords = False
On Error GoTo TransferTableToSqlServer_qdfError
qdf.Execute dbFailOnError
On Error GoTo 0
Set qdf = Nothing
Set cdb = Nothing
DoCmd.TransferDatabase _
acExport, _
"ODBC Database", _
ConnectionString, _
acTable, _
"CDData", _
DestinationTableName, _
False
Exit Function
TransferTableToSqlServer_qdfError:
For Each err In dao.Errors
MsgBox err.Description, vbCritical, "Error " & err.Number
Next
End Function
I'm trying to export data from Excel 2010 to Access 2010 with a VBA code on my excel file when I press a button. I just want to export the data from "Water Quality" sheet to the "Water Quality" table on my database (In the excel file and access file are other sheets and tables).
My actual code is:
Sub Button14_Click()
' Exports data from the active worksheet to a table in an Access database
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim r As Long
Dim LastRow As Long
' Set cn = New ADODB.Connection
'cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
"Data Source=C:\Documents and Settings\Administrador\Mis documentos\MonEAU\modelEAU Database V.2.accdb; " & _
"Persist Security Info=False;"
strCon = "Provider=Microsoft.ACE.OLEDB.12.0; " & _
"Data Source=C:\Documents and Settings\Administrador\Mis documentos\MonEAU\modelEAU Database V.2.accdb"
' Late binding, so no reference is needed
Set cn = CreateObject("ADODB.Connection")
cn.Open strCon
' Find LastRow in Col A into the Sheet1
LastRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
' Insert unto a table called Water_Quality
scn = "[Excel 8.0;HDR=YES;DATABASE=" & ActiveWorkbook.FullName & "]"
strSQL = "INSERT INTO Water_Quality " _
& "SELECT * FROM " & scn & ".[Sheet1$A5:L" & LastRow & "]"
' Execute the statement
cn.Execute strSQL
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
End Sub
I can debug without any problem the code but when I run it, a run error appears: "The Microsoft Office Access database engine could not find the object 'Sheet1$A5:L10'. Make sure the object exists and that you spell its name and the path name correctly." It seems that there's a problem with the line cn.Execute strSQL.
I've checked the names and the path name as well, and I can't find where the problem is.
Any help to solve it would be greatly appreciated.
Here are a few examples for inserting all the data at once:
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=z:\docs\test.accdb"
''Late binding, so no reference is needed
Set cn = CreateObject("ADODB.Connection")
cn.Open strCon
''Create a table called ATable
scn = "[Excel 8.0;HDR=YES;DATABASE=" & ActiveWorkbook.FullName & "]"
strSQL = "SELECT * INTO ATable " _
& "FROM " & scn & ".[Sheet7$A1:C4]"
''Execute the statement
cn.Execute strSQL
''Insert into a table called ATable
scn = "[Excel 8.0;HDR=YES;DATABASE=" & ActiveWorkbook.FullName & "]"
strSQL = "INSERT INTO ATable " _
& "SELECT * FROM " & scn & ".[Sheet7$A1:C4]"
''Execute the statement
cn.Execute strSQL
''Insert into a table with no column header in Excel,
''the fields are [afield],[atext],[another]
scn = "[Excel 8.0;HDR=NO;DATABASE=" & ActiveWorkbook.FullName & "]"
strSQL = "INSERT INTO ATable ([afield],[atext],[another]) " _
& "SELECT F1 As afield, F2 As AText, F3 As another FROM " _
& scn & ".[Sheet7$A1:C4]"
''Execute the statement
cn.Execute strSQL