I would like to create the dropdown list with the results from my query. I'm looking for help please because I don't know how to display this results on the list.
The exemple of the list:
My query is :
'DROPDOWN LIST
Private Sub cb_gest_Change()
If Not FSD.cb_gest.MatchFound And FSD.cb_gest <> "" Then
MsgBox "Saisie impossible, le gestionnaire n'existe pas !", , "Contrôle
Gestionnaire"
FSD.cb_gest = ""
Else
FSD.Cells(29, COL_DATA) = FSD.cb_gest
End If
End Sub
'DROPDOWN LIST
Sub init_combo()
Dim Resultat As ADODB.Recordset
Dim Requete As String
FSD.cb_gest.Clear
Requete = "select lb_gestion from DB_GESTIONNAIRE "
Requete = Requete + "WHERE (d_deb_valid <= TRUNC(SYSDATE) OR d_deb_valid IS
NULL) AND (d_fin_valid >= TRUNC(SYSDATE) OR d_fin_valid IS NULL)"
Requete = Requete + " ORDER BY LB_GESTION"
Set Resultat = New ADODB.Recordset
Resultat.ActiveConnection = oBase
Resultat.Source = Requete
Resultat.Open
While Not Resultat.EOF
FSD.cb_gest.AddItem Resultat!lb_gestion
Resultat.MoveNext
Wend
If FSD.Cells(29, COL_DATA).Value <> "" Then
FSD.cb_gest = FSD.Cells(29, COL_DATA).Value
Else
FSD.Cells(29, COL_DATA).Value = ""
End If
End Sub
Thank you for your help !
Consider a different, codeless approach:
Add a new sheet to the host document / workbook
Import the external data from the "Data" Ribbon tab (select "From SQL Server")
Excel creates a ListObject table backed with a QueryTable object that uses a WorkbookConnection that can be configured to automatically refresh on open, or left alone as a one-time pull.
Select the produit column in the ListObject/table; Excel highlights the entire column content and leaves the heading un-selected.
From the "Formulas" Ribbon tab, click the "Define Name" command in the "Defined Names" group.
Name the range ProductsList, verify it refers to TableName[produit] so that it automatically grows and shrinks to fit the column contents.
Change the data validation list to =ProductsList.
Hide the worksheet housing the query and table, if needed.
No code needed, and the validation list will always keep up with the query results as they are refreshed.
Side note, the query appears to be making inefficient cross-joins, and at least one of them is a where-join that can be expressed as an inner join. Are you sure the query is yielding the expected records (I'm suspecting it's yielding a ton of duplicates, depending on how many records exist in the cross-joined tables)?
SELECT prod.cd_produit AS produit
FROM db_dossier sousc, db_produit prod, db_protocole proto, db_tiers tiers, db_personne pers
WHERE sousc.cd_dossier = 'SOUSC' AND sousc.lp_etat_doss NOT IN ('ANNUL','A30','IMPAY') AND sousc.is_produit = prod.is_produit
Instinct would be to remove the tables we're not selecting or filtering anything from - if this query produces the same expected output, then assuming primary and foreign keys are defined I believe its execution plan would be more efficient:
SELECT prod.cd_produit AS produit
FROM db_dossier AS sousc
INNER JOIN db_produit AS prod ON sousc.is_produit = prod.is_produit
WHERE sousc.cd_dossier = 'SOUSC' AND sousc.lp_etat_doss NOT IN ('ANNUL','A30','IMPAY')
Related
I am connecting to a SQL Server and am trying to limit the results by adding parameters. The first parameter I added, #sdate, worked just fine. But, now I am trying to add a second parameter which is not working. I want the field, LP_EOC_DATA.PL, to only be returned if the length of the string is greater than 6 characters long. The code below executed, and like I say, the dates returned were correct, but it also returned values from LP_EOC_DATA.PL that had string lengths less than 6. Please let me know if you know how to get this to work. Thanks in advance.
Sub doSQL()
Dim myConn As SqlConnection
Dim myCmd As SqlCommand
Dim myReader As SqlDataReader
Dim sqlString As String = "SELECT LP_EOC_DATA.PL as PLs, LP_EOC_DATA.cDate as ReadDate, LP_EOC_LOV.LOCATION as Location " &
"FROM LP_EOC_DATA INNER JOIN LP_EOC_LOV ON LP_EOC_DATA.PIC = LP_EOC_LOV.PIC " &
"WHERE LP_EOC_DATA.cDate > (#sdate) AND LEN(LP_EOC_DATA.PL) > #slen1 " &
"UNION SELECT dbo.VT_DATA.PL as PLs, dbo.VT_DATA.cDate as ReadDate, dbo.VT_LOV.LOCATION as Location " &
"FROM dbo.VT_DATA INNER JOIN dbo.VT_LOV ON dbo.VT_DATA.PIC = dbo.VT_LOV.PIC " &
"WHERE dbo.VT_DATA.cDate > (#sdate) AND LEN(dbo.VT_DATA.PL) > #slen1 " &
"ORDER BY ReadDate;"
myConn = New SqlConnection("SERVER=ServerName;UID=uName;" &
"PWD=Password;")
myCmd = myConn.CreateCommand
myCmd.CommandText = sqlString
myCmd.Parameters.AddWithValue("#sdate", DateTimePicker1.Value)
myCmd.Parameters.AddWithValue("#slen1", 6)
'myCmd.Parameters.AddWithValue("#rx1", "'%[^0-9a-z]%'")
'myCmd.Parameters.AddWithValue("#rx2", " dbo.VT_DATA.PL NOT LIKE '%[^0-9a-z]%'")
myConn.Open()
myReader = myCmd.ExecuteReader()
Table.Load(myReader)
DataGridView1.Visible = True
DataGridView1.DataSource = Table
lblTotal.Text = Table.Rows.Count
End Sub
Also, as you can see, I am looking to add another parameter that only returns alphanumeric results from the same LP_EOC_DATA.PL field. I haven't got quite that far yet, but if you see something I'm doing wrong there too, I'd appreciate the input.
It helps if you format your SQL a little more. There's some structure, but it still comes off as a big wall of text. It's even harder for us to debug than it is for you, since we don't know your schema at all. There are also a number of other little things you should do different before we even address the question (Using block so connection is closed in case of exception, avoid AddWithValue() for index safety, isolate SQL from user interface, etc):
Function doSQL(StartDate As DateTime) As DataTable
Dim result As New DataTable
Dim sqlString As String = _
"SELECT LP_EOC_DATA.PL as PLs, LP_EOC_DATA.cDate as LPRReadDate, LP_EOC_LOV.LOCATION as Location " &
"FROM LP_EOC_DATA " &
"INNER JOIN LP_EOC_LOV ON LP_EOC_DATA.PIC = LP_EOC_LOV.PIC " &
"WHERE LP_EOC_DATA.cDate > #sdate AND LEN(COALESCE(LP_EOC_DATA.PL,'')) > #slen1 " &
"UNION " &
"SELECT dbo.VT_DATA.PL as PLs, dbo.VT_DATA.cDate as ReadDate, dbo.VT_LOV.LOCATION as LPRLocation " &
"FROM dbo.VT_DATA " &
"INNER JOIN dbo.VT_LOV ON dbo.VT_DATA.PIC = dbo.VT_LOV.PIC " &
"WHERE dbo.VT_DATA.cDate > #sdate AND LEN(COALESCE(dbo.VT_DATA.PL,'')) > #slen1 " &
"ORDER BY ReadDate;"
Using myConn As New SqlConnection("SERVER=ServerName;UID=uName;" &
"PWD=Password;"), _
myCmd As New SqlCommand(sqlString, myConn)
myCmd.Parameters.Add("#sdate", SqlDbType.DateTime).Value = StarDate
myCmd.Parameters.Add("#slen1", SqlDbType.Int).Value = 6
myConn.Open()
result.Load(myCmd.ExecuteReader())
End Using
Return result
End Function
And then call it like this:
Dim tbl As DataTable = doSql(DateTimePicker1.Value)
DataGridView1.Visible = True
DataGridView1.DataSource = tbl
lblTotal.Text = tbl.Rows.Count
As for the question, there are a few possibilities: NULL values can give unexpected results in this kind of situation (the code I posted already accounts for that). You may also have trouble with certain unicode whitespace padding your character count. Another possibility is char or nchar fields instead of varchar or nvarchar, though I don't think that's the issue here.
This is not an answer to the question per se but a reply to the request for an XML literal example. As that requires a few lines of code, I'd rather not put it in a comment.
Dim sql = <sql>
SELECT *
FROM MyTable
WHERE MyColumn = #MyColumn
</sql>
Dim command As New SqlCommand(sql.Value, connection)
Note that the element name can be anything you want but I usually use 'sql' when it's for SQL code.
I've written an export (Access to Excel) function in an application that works in ranges.
The user has 4 RadioButtons: A-F, G-M, N-R and S-Z.
Let's say the user has selected rbtnAF, which will load all customers into the grid where the Customer_Code field starts with an A, B, C, D, E or F.
The code to load in the data is as follows:
Dim strFields As String = "[Customer_Addresses].[Cust_Code], [Customers].[Customer_Name], [Customer_Addresses].[Contact_Code], [Customer_Addresses].[Contact_Name], " & _
"[Customer_Addresses].[Contact_Type], [Customer_Addresses].[Add1], [Customer_Addresses].[Add2], [Customer_Addresses].[Add3], [Customer_Addresses].[Add4], " & _
"[Customer_Addresses].[Add5], [Customer_Addresses].[Postcode], [Customer_Addresses].[Country], [Customer_Addresses].[Telephone], [Customer_Addresses].[Fax], " & _
"[Customer_Addresses].[Email], [Customer_Addresses].[Mobile_Phone], [Customers].[Customer_Category], [Customers].[Average_Payment_Terms], " & _
"[Customers].[Notes], [Customers].[salesRep], [Customers].[hoEmail], [Customers].[webpage] FROM Customers " & _
"INNER JOIN Customer_Addresses ON [Customers].[Customer_Code] =[Customer_Addresses].[Cust_Code]"
If rbtnAF.Checked = True Then
sql = "SELECT " & strFields & " WHERE [Customer_Addresses].[Cust_Code] BETWEEN " & _
"'A*' AND 'F*' ORDER BY [Customer_Addresses].[Cust_Code]"
Dim da As New OleDbDataAdapter(sql, con)
Dim ds As New DataSet
Dim dt As New System.Data.DataTable
da.Fill(ds)
dt = ds.Tables(0).Copy()
ugExport.DataSource = Nothing
ugExport.DataSource = dt
This was, I thought, working fine, I was able to load the correct ranges into the grid and export them as I wanted.
However, the user has come back to me and said it's not loading all customers.
I thought this was a bit weird, so I loaded up their database and tested it for myself. In the DB, there are 4 customers who fit into the range of A-F, as you can see in this image.
However, when I then view the customer range A-F in the export list, there are only 2 customers displayed.
It's also worth noting, in the Customer List screen there is a TextBox to allow the user to search by customer code - When I type in just a single F, all 4 customers are displayed as expected.
What on Earth is going on to only display 2 of the results in the Export List, despite there being 4 records that fit the criteria?
Checking the between syntax you will find that it treats * as a literal character see here https://support.office.com/en-us/article/Between-And-Operator-a435878d-63f7-4825-8c31-999432ae8223
You can use
Like "[A-F]*"
Instead though.
Good Afternoon,
I have an access query that contains a list of all my customers lets call that CUS
I have another query that has a list of ORDERS
I would like to write some VBS that cycles through the customer list and exports a csv file containing all orders that belong to that customer.
The vba would then move on to the next customer on the list and perform the same action.
Any help would be great.
Snippet of code below
almost there cant get the WHERE condition working it keeps displaying a popup for me to populate however the same string is feeding the msgbox fine here is a snippet below tht is within the loop
strcustcode = rs!OCUSTCODE
ordercount = rs!orders
TIMEFILE = Format$(Time, "HHMM")
MsgBox ([strcustcode] & " has " & [ordercount] & " orders")
StrSQL = "Select * From [24-ND_Cus] where [24-ND_Cus].[OCUSTCODE] = strcustcode "
Set qd = db.CreateQueryDef("tmpExport", StrSQL)
DoCmd.TransferText acExportDelim, , "tmpExport", "c:file.csv" db.QueryDefs.Delete "tmpExport" –
Don't use [ ] around VBA variables. Don't use parens for the MsgBox when you just want to give user a message. The parens make it a function that requires a response by user to set a variable.
MsgBox strcustcode & " has " & ordercount & " orders"
Concatenate the variable into the SQL statement. If OCUSTCODE is a text type field, use apostrophe delimiters for the parameter.
StrSQL = "Select * From [24-ND_Cus] Where [OCUSTCODE] = '" & strcustcode & "'"
I don't advise code that routinely modifies design and changing a query SQL statement is changing design. If the only change is filter criteria and a dynamic parameterized query won't work, I suggest a 'temp' table - table is permanent, data is temporary. Delete and write records to the table and export the table.
My code want to query access very frequently, I use "for" for every row and check a cell's value if existed in access table. But I feel the performance is very bad. Now I'm using adodb.connection to connect to access. Sorry I cannot put code because its not in my hand. Anyone could help me about how to query a table very frequently from excel vba and with fast performance?
EDIT:
For rowNum = 2 To 1000000
'check if title exists,if yes, get ppid, if not, insert one, get ppid, and make relation in r-table
ppID = isTitleExistReturnID(ppTitle)
If ppID = "0" Then
ppID = addPpReturnID(ppTitle, ppDate, ppJournal)
paperAddedCount = paperAddedCount + 1
isPpAdded = True
Else
isPpAdded = False
End If
Next rowNum
Function isTitleExistReturnID(title As String) As String
Dim r As New ADODB.Recordset
sqlstr = "select * from paper where title = '" & title & " '"
'MsgBox sqlstr
dbConnection.Open
r.Open sqlstr, dbConnection, adOpenKeyset, adLockOptimistic, adCmdText
If r.RecordCount < 1 Then
dbConnection.Close
isTitleExistReturnID = "0"
Else
aidi = r.Fields(0).Value
dbConnection.Close
isTitleExistReturnID = aidi
End If
End Function
Function addPpReturnID(title As String, pubDate As String, journaL As String) As String
Dim r As New ADODB.Recordset
sqlstr = "select * from paper where (1=0)"
'MsgBox sqlstr
dbConnection.Open
r.Open sqlstr, dbConnection, adOpenKeyset, adLockOptimistic, adCmdText
r.AddNew
r.Fields(1) = title
r.Fields(2) = pubDate
r.Fields(3) = journaL
r.Update
maxid = CStr(r.Fields(0).Value)
dbConnection.Close
addPpReturnID = maxid
End Function
The above is part of my code:
check if the item is in access table
if YES, return its ID
if NO, add this item and return ID
Do it for more than 100,000 times, very low performance
Any advice will be so appreciated, thanks in advance.
Any RBAR (row by agonizing row) approach has the potential to be a performance challenge --- that's why it's called agonizing.
And yours is definitely RBAR because you do stuff separately for each of a million (For rowNum = 2 To 1000000) spreadsheet rows. Compounding the problem is the fact that you're opening and closing ADODB objects (connections and recordsets) at least one, but sometimes twice, for each of those rows.
Try to find a set-based approach instead. For example, if you can drive this operation from Access ...
Create a link to the spreadsheet.
Create an "unmatched" query (there is a query wizard to guide you) to select those spreadsheet rows whose ppTitle does not exist in the Access destination table.
Create an "append" query to add those unmatched rows to the Access table.
I don't know whether that outline is a suitable fit for your situation or whether it's close enough that you can adapt it. But the more important point is to find a set-based method instead of RBAR.
I have an Excel Spreadsheet that calculates a risk (of perioperative mortality after aneurysm repair) based on various test results.
The user inputs the test results into the spreadsheet (into cells) and then out comes a set of figures (about 6 results) for the various models that predict mortality. The spreadsheet acts as a complex function to produce the results one patient at a time.
I also have a (separate) access database holding data on multiple patients - including all the data on test results that go into the spreadsheet. At the moment I have to manually input this data into the spreadsheet, get the results out and then manually enter them onto the database.
Is there a way of doing this automatically. Ie can I export data1, data2, data3... from Access into the spreadsheet to the cells where the data needs to be input and then get the results (result1, result2, result3...) from the cells where the results are displayed ported back into access.
Ideally this could be done live.
I suppose I could try to program the functionality of the spreadheet into a complex function in access, but if I'm honest, I am not really sure how the algorithm in the spreadsheet works. It was designed by anaesthetists who are much cleverer than me....
Hope this makes sense. Any help much appreciated.
Chris Hammond
It's possible to automate Excel from Access.
Const cstrFile As String = "C:\SomeFolder\foo.xls"
Dim xlApp As Object
Dim xlWrkBk As Object
Dim xlWrkSt As Object
Set xlApp = CreateObject("Excel.Application")
xlApp.Workbooks.Open cstrFile, ReadOnly:=True
Set xlWrkBk = xlApp.Workbooks(1)
Set xlWrkSt = xlWrkBk.Worksheets(1)
With xlWrkSt
.Range("A1") = 2
.Range("A2") = 19
Debug.Print .Range("A3")
End With
xlWrkBk.Close SaveChanges:=False
However, that seems like it would be cumbersome to repeat for each row of an Access table and I'm uncertain whether doing that live is reasonable.
I would try to adapt the Excel calculations to Access VBA functions and use those custom functions in an Access query. But I don't know how big of a task that would be. I suggest you shouldn't be scared off the the anaesthetists' cleverness; that doesn't mean they actually know much more about VBA than you. At least look to see whether you can tackle it.
To push the data back to Access, you can insert data from within the Excel VBA as follows:
dim val as variant
dim db as DAO.Database
val=thisworkbook.range("a1").value
set db=OpenDatabase("c:\myAccessDB.accdb")
db.execute "insert into patientData (someField) values (" & val & ")",dbFailOnError
db.Close
You'll need to add a reference to the Microsoft Office Access Database Engine Object Library.
Not sure to perfectly understand what you want, but if you just want to export the results of a query to a spreadsheet, you could use the following:
Private Sub ExportAccessDataToExcel()
Dim SqlString As String
SqlString = "CREATE TABLE testMeasurements (TestName TEXT, Status TEXT)"
DoCmd.RunSQL (SqlString)
SqlString = "INSERT INTO testMeasurements VALUES('Average Power','PASS')"
DoCmd.RunSQL (SqlString)
SqlString = "INSERT INTO testMeasurements VALUES('Power Vs Time','FAIL')"
DoCmd.RunSQL (SqlString)
SqlString = "SELECT testMeasurements.TestName, testMeasurements.Status INTO exportToExcel "
SqlString = SqlString & "FROM testMeasurements "
SqlString = SqlString & "WHERE (((testMeasurements.TestName)='Average Power'));"
DoCmd.RunSQL (SqlString)
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel7, "exportToExcel", "C:\TestMeasurements.xls", True, "A1:G12"
End Sub
Source: http://www.ehow.com/how_7326712_save-access-query-excel-vba.html
This could be done either directly from the database or from Excel (you would need to open the database with Excel VBA to do so, but most of the Office Suite products interact well with each other).
If you want to push the data of your spreadsheet into an Access database, that's different. You just have to open the database and loop through INSERT query. Here is a quick example, you just need to add the loop:
Dim db as DAO.Database
Set db = OpenDatabase(myDataBase.mdb)
Call db.Execute("INSERT INTO myTable (Field1, Field2) VALUES('Value1', 'Value2')")