I have a continuous form in MS Access 2003. The source data is a SQL Server link table. I display all the data by the SQL Server table and under the data I have text boxes to search in the above fields (of the form). I have made a routine for dynamic search which I call from the after_update event of the text box. Previously when I had the data in the MS Access backend it was working properly but now that I moved the data from MS Access backend to SQL Server table (backend) it does not work properly when I hit enter and I can't make my search. Any ideas? Thank you.
My Routine dynamic search:
Private Function DynamicSearch(ctl As CONTROL)
On Error Resume Next
Dim strfilter As String
Dim LikeMember As String
If Len(ctl.Text) > 0 Then
SendKeys ("{F2}")
strfilter = ctl.Text
LikeMember = Replace(ctl.Name, "Search", vbNullString)
If Len(Me.FILTER) > 0 Then
Me.FILTER = Me.FILTER & " AND " & LikeMember & " like '*" & strfilter & "*'"
Else
Me.FILTER = LikeMember & " like '*" & strfilter & "*'"
End If
Me.FilterOn = True
Else
If Me.FilterOn Then
Me.FilterOn = False
ctl.SetFocus
SendKeys ("{F2}")
End If
End If
End Function
Related
I see there are a lot of questions on this issue, but I thought I'd add to it again. I'm trying to run Pass Through queries to put the load on the server instead of wimpy Access. Almost every table I have is stored in a SQL server, but I have a large table I have to loop through and it's much faster if I copy it to a local table and then loop through it. Otherwise, everything is faster or fast enough when going through the pass through functions.
The table in question currently holds about 25k lines and if I just write a query to have access copy the local table to SQL server it takes about 1 hour. However, if I use a pass through query with insert, I can copy it over in about 47 seconds. My problem seems to come when I try to pass too long of a string of text.
Here is my function that run the pass through query
Public Sub RunPassThruQdf(sqlCode As String, Optional isTestDB As Boolean = False)
Dim qdf As QueryDef
Set qdf = CurrentDb.QueryDefs("vbaSQL")
If isTestDB Then
qdf.Connect = "ODBC;DSN=DataWarehouse_Test;Description=DataWarehouse_Test;UID=**username**;PWD=**password**;APP=Microsoft Office;DATABASE=DataWarehouse_test"
'The above line is where the error happens when I debug
Else
qdf.Connect = "ODBC;DSN=DataWarehouse;Description=DataWarehouse;UID=**username**;PWD=**password**;APP=Microsoft Office;DATABASE=DataWarehouse"
End If
qdf.ReturnsRecords = False
qdf.sql = sqlCode
Do Until InStr(qdf.sql, " ") = 0
qdf.sql = Replace(qdf.sql, " ", " ")
Loop
qdf.Execute
qdf.Close
End Sub
You'll notice that it connects with a special login (redacted) because I can't make changes to the server myself, but that user account can. And that last loop removes double spaces until everything is separated by a single space to reduce the string size as much as possible.
And this is the function that copies the local table to the server table
Public Sub LoadUnidentifiedFromLocal()
Dim rst As New RecordsetClass: rst.OpenR "tblUnidentifiedParts_Local"
Dim dtm As Date: dtm = Now
Dim baseSQL As String: baseSQL = "INSERT INTO [DataWarehouse_test].[dbo].[mT_SalesAttributeDB_UnidentifiedParts] (ID, PartNumber, FamilyNumber, AutoNote, ManualNote, Created, Updated) VALUES "
Dim sql As String
RunPassThruQdf "SET IDENTITY_INSERT [DataWarehouse_test].[dbo].[mT_SalesAttributeDB_UnidentifiedParts] ON", True
Dim i As Integer: i = 1
Do Until rst.EOF
If sql = vbNullString Then sql = baseSQL
If i Mod 500 = 0 Then
RunPassThruQdf sql, True
'Debug.Print i & ": " & Format(Now - dtm, "hh:mm:ss") & " (" & Format(Len(sql), "#,##0") & ")"
'DoEvents
sql = baseSQL
End If
Dim addSQL As String: addSQL = "(" & rst.Fields("ID") & ", '" & rst.Fields("PartNumber") & "', '" & rst.Fields("FamilyNumber") & "', '" & rst.Fields("AutoNote") & "', '" & rst.Fields("ManualNote") & "', '" & rst.Fields("Created") & "', '" & rst.Fields("Updated") & "')"
If sql = baseSQL Then
sql = sql & addSQL
Else
sql = sql & ", " & addSQL
End If
rst.MoveNext
i = i + 1
Loop
If sql <> vbNullString Then
RunPassThruQdf sql, True
Debug.Print i & " " & Format(Now - dtm, "hh:mm:ss")
End If
RunPassThruQdf "SET IDENTITY_INSERT [DataWarehouse_test].[dbo].[mT_SalesAttributeDB_UnidentifiedParts] OFF", True
rst.CloseR
End Sub
Where I have that mod 500 is me trying to figure out how many lines I can copy over until I get that System resources exceeded error. You'll probably also notice I have a special rst class I made. But just know that it mimics the normal one, I just have some special functions in there so it was my version of inheritance since VBA doesn't support that.
The first time I got it I googled and found that someone was able to fix their error by change the max lock to 1 million. And that worked for me too, until I exceeded it. DAO.DBEngine.SetOption dbMaxLocksPerFile, 1000000
I know it's not a problem with my computer, it's 6 core Xeon W-10855M with 64GB of ram. But I will see that error even after restart for a while and then it will just stop and work again until I try to send it too much and then I'm stuck seeing it for a bit. What is weird is even restarting my computer will not fix the issue. And I've tried compress and repair and that won't fix it either. So I'm not clear what changes so that it stops reporting that.
But my first question is if increasing the max locks per file helped, is there a way to clear what locks are currently there? My second question would be how big of a string can I send with a pass through, I think I saw somewhere in the neighborhood of 65k before I got the message (That was when I had it set at i mod 500.
I am trying to pass over 37K values in the WHERE clause using IN operator through Excel VBA macro. However, due to resource limitation in Microsoft SQL Server, the query won't execute. I have tried to pass the values in an array in VBA as well as tried creating a list in in SQL. Neither are able to accommodate these many values. Can somebody help? Sharing the code I have tried below.
Dim i as Long
Dim str As String
Dim dict_pn
Set dict_pn = CreateObject("Scripting.Dictionary")
i = 1
With InputS
For i = 1 to 50000
str = Trim(.Cells(i, PN_Col).Value)
dict_pn.Add str, 0
Next
With rsPubs
' Assign the Connection object.
.ActiveConnection = cnPubs
.Open Worksheets("SQL Script").Range("A1") & "('" & Join(dict_pn.keys, "','") & "') " & Worksheets("SQL Script").Range("A2") & "('" & Join(dict_pn.keys, "','") & "') " & Worksheets("SQL Script").Range("A3") & "('" & Join(dict_pn.keys, "','") & "') "
ActiveWorkbook.Worksheets("SQL Results").Range("A3").CopyFromRecordset rsPubs
You should transmit data to SQL Server like in related post
Sub UpdateTable()
Dim cnn As Object
Dim wbkOpen As Workbook
Dim objfl As Variant
Dim rngName As Range
Workbooks.Open "C:\your_path_here\Excel_to_SQL_Server.xls"
Set wbkOpen = ActiveWorkbook
Sheets("Sheet1").Select
Set rngName = Range(Range("A1"), Range("A1").End(xlToLeft).End(xlDown))
rngName.Name = "TempRange"
strFileName = wbkOpen.FullName
Set cnn = CreateObject("ADODB.Connection")
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFileName & ";Extended Properties=""Excel 12.0 Xml;HDR=Yes"";"
nSQL = "INSERT INTO [odbc;Driver={SQL Server};Server=Server_Name;Database=[Your_Database].[dbo].[TBL]]"
nJOIN = " SELECT * from [TempRange]"
cnn.Execute nSQL & nJOIN
MsgBox "Uploaded Successfully"
wbkOpen.Close
Set wbkOpen = Nothing
End Sub
and then you can do any you want - use operator IN or LEFT JOIN whith check for null on SQL server side.
You can use temporary table if you will not close connection - temp table exists only in session level.
This is way from VBA code.
Second way - you can use SSIS package to work with excel files. In package you will have same steps - data frlow to transmit data from excel to server and then run sql code to join data. Or you can use join block inside SSIS package.
Third way that you can implement if data in SQL server less than excel row count limit. You can import data from SQL into Excel sheet, and than use VLOOKUP() function to join tables and find related data.
Current Situation
I have a database in MSSQL and currently it is able to link to excel the following way.
Excel table which is connected to MSSQL as follows
MSSQL table as below
Currently if I update my MSSQL table, excel table will update accordingly
What I need
I want the vice versa operation. Means whenever I update the excel table, MSSQL also needs to update. Is this possible?
I am able to do it correctly by using following code
Sub updateSqlFromExcel()
Dim cnn As ADODB.connection
Dim uSQL As String
Set cnn = New connection
cnnstr = "Provider=SQLOLEDB; " & _
"Data Source=myServer; " & _
"Initial Catalog=myDatabaseName;" & _
"User ID=username;" & _
"Password=password;" & _
"Trusted_Connection=No"
Set rngName = ActiveCell
cnn.Open cnnstr
excelId = ActiveCell.Value 'This is just an example
excelSeq = ActiveCell.Offset(0, 1).Value 'This is just an example
excelName = ActiveCell.Offset(0, 2).Value 'This is just an example
uSQL = "UPDATE myTableName SET Name = '" & excelName & "', Seq = '" & excelSeq & "' WHERE ID= '" & excelId & "' "
cnn.Execute uSQL
ActiveWorkbook.RefreshAll
MsgBox "Updated successfully. But please wait until background refresh finish before close excel", vbInformation, "Success"
cnn.Close
Set cnn = Nothing
End Sub
Please change myServer, myDatabaseName, username, passwordand myTableNameaccording to your settings in order for this macro to work. Also please add reference library Microsoft ActiveX Data Objects 2.8 Library. In order to add, press Alt+F11 and then goto Tools --> References. Scroll to Microsoft ActiveX Data Objects 2.8 Library and tick the checkbox. Press ok and you are ready to go.
I am new to Access and am need of help with multi-text box search form in Access 2016. My form has 6 fields in which users can input data to get search result in the subform. Users would need to have the option to enter search parameters in one or more fields to get results. We have a similar form in an Access 2003 database that people love. I have tried copying and updating the code from the Access 2003 database, but I can't seem to get it to work in the 2016 database. I have spent weeks searching for answers and am at a total loss.
The below code is what I copied from the Access 2003 database and updated for the current database:
Private Sub cmdWCSearch_Click()
Dim strsql As String
strsql = "SELECT * FROM qryWCSearch WHERE ID > 0"
If Not IsNull(Me.WCLastName) Then
strsql = strsql & "And [WCLastName] Like '*" & Me.WCLastName & "*'"
End If
If Not IsNull(Me.WCDOI) Then
strsql = strsql & "And [WCDOI] Like '*" & Me.WCDOI & "*'"
End If
If Not IsNull(Me.WCWorkStatus) Then
strsql = strsql & "And [WCWorkStatus] Like '*" & Me.WCWorkStatus & "*'"
End If
If Not IsNull(Me.WCClaimNumber) Then
strsql = strsql & "And [WCClaimNumber] Like '*" & Me.WCClaimNumber & "*'"
End If
If Not IsNull(Me.WCBodyPart) Then
strsql = strsql & "And [WCBodyPart] Like '*" & Me.WCBodyPart & "*'"
End If
If Not IsNull(Me.WCClaimStatus) Then
strsql = strsql & "And [WCClaimStatus] Like '*" & Me.WCClaimStatus & "*'"
End If
End Sub
In the query I have Like "*" & [Forms]![WelcomePage]![WCLastName] & "*" Or ([Forms]![WelcomePage]![WCLastName] Is Null) under the criteria.
Whenever I run the search I get an error message saying "The expression On Click you entered as the event property setting produced the following error: A problem occurred while Microsoft Access was communicating with the OLE server or ActiveX Control."
Any help in getting this to work would be greatly appreciated!
You need a space in front of all your "And"s:
If Not IsNull(Me.WCLastName) Then
strsql = strsql & " And [WCLastName] Like '*" & Me.WCLastName & "*'"
End If
I use external data from an SQL query in excel to pull data onto a spreadsheet then the spreadsheet can be sent to one of my colleges in say the sales department and they can view the queried information.
I want to be able to have a cell that they can enter data into and press a refresh button.
So I need to do some thing like this:
SELECT Customer.CustomerCode, Customer.Name,
OrderHeader.OrderType, OrderHeader.OrderNumber
FROM Customer INNER JOIN
OrderHeader ON Customer.CustomerID = OrderHeader.CustomerID
WHERE (OrderHeader.OrderType = 2) AND (OrderHeader.OrderNumber = Range("A1").Value)
Not sure how or if this is possible and the reason I need to do this is because i'm going through lines from all the Quotes and if there is over 65536 then i'll have a problem.
This is what I have at the moment the SQL is different but that doesn't matter
The easiest way is to pull the values for the parameters into VBA, and then create the SQL statement as a string with the parameter values, and then populate the commandtext of the query.
Below is a basic example of the parameter in cell A1.
Sub RefreshQuery()
Dim OrderNo As String
Dim Sql As String
' Gets value from A1
OrderNo = Sheets("Sheet1").Range("A1").Value
'Creates SQL Statement
Sql = "SELECT Customer.CustomerCode, Customer.Name, " & _
"OrderHeader.OrderType , OrderHeader.OrderNumber " & _
"FROM Customer " & _
"INNER Join OrderHeader ON Customer.CustomerID = OrderHeader.CustomerID " & _
"WHERE (OrderHeader.OrderType = 2) And (OrderHeader.OrderNumber = " & OrderNo & ") "
With ActiveWorkbook.Connections(1).ODBCConnection
.CommandText = Sql
.Refresh
End With
End Sub
This assumes you have the query in Excel to begin with, and that it's the only query. Otherwise you'll have to define the name of the query as below:
With ActiveWorkbook.Connections("SalesQuery").ODBCConnection
I hope that helps :)
Further to #OWSam's example using ODBC, we can also use ADO to pull back query results from SQL Server. Using ADO, you cannot use windows verification and you will need the user to input their password somehow, to be able to run the query.
Personally I create a userform which has UserName and Password. Username pre-populated using Environ, and then they can type their password into the relevant TextBox.
Sub sqlQuery()
Dim rsConn As ADODB.Connection, rsData As ADODB.Recordset
Dim strSQL As String, winUserName As String, pwd As String
winUserName = UCase(Environ("username"))
pwd = "mypassword" 'password needed here.
strSQL = "SELECT * FROM mydatabase" 'query
Set rsConn = New ADODB.Connection
With rsConn
.ConnectionString = "Provider = sqloledb;" & _
"Data Source = [server name here];" & _
"Initial Catalog = [initial database];" & _
"Integrated Security=SSPI;" & _
"User ID = " & winUserName & ";" & _
"Password = " & pwd & ";"
.Open
End With
Set rsData = rsConn.Execute(strSQL)
Range("A1").CopyFromRecordset rsData
End Sub
Edit: You must go into references and turn on the Microsoft ActiveX Data Objects Recordset 6.0 library (or equivalent within your VBE).