How to display more data from the database (access) in VBA? - database

What's the matter. After selecting a name from a ComboBox in ListBox have to display all the employees of the chosen company. And now my problem, always in a ListBox displays only 2 employees of the chosen company. The following piece of code responsible for displaying. For the record, I'm new in VBA. And of course, my question is why only two employees?
Procedure-click on the selected company from ComboBox:
Dim RecordSt As Recordset
Dim db As Database
Dim query As String
Dim strKombi30 As String
Dim i As Integer
strKombi30 = Me.Kombi30.Value ''combobox
query = "SELECT [Employees].[First name], [Employees].[Name] FROM" & _
"[Employees] WHERE [Employees].[Company] = '" & Me.Kombi30
Set db = CurrentDb()
Set RecordSt = db.OpenRecordset(query)
RecordSt.MoveFirst
For i = 0 To RecordSt.RecordCount
listContacts.AddItem (RecordSt.Fields("First name").Value & " " & RecordSt.Fields("Name").Value)
RecordSt.MoveNext
Next i

strKombi30 = Me.Kombi30.Value ''combobox
query = "SELECT [Employees].[First name], [Employees].[Name] FROM" & _
"[Employees] WHERE [Employees].[Company] = '" & strKombi30 & "'"

Related

Select data from mssql using excel vba and where statement

I need select data from database, using Excel. I want to select only one column from database and I need use where statement (to select only data which have the same unique value as data in Excel sheet)
I tried this
Sub DB_RTVresult()
Dim Cn As ADODB.Connection
Dim Server_Name As String
Dim Database_Name As String
Dim User_ID As String
Dim Password As String
Dim SQLStr As String
Dim myRes As ADODB.Recordset
Server_Name = "123" ' Enter your server name here
Database_Name = "DBName" ' Enter your database name here
User_ID = "UserName" ' enter your user ID here
Password = "Pass" ' Enter your password here
Set myCon = New ADODB.Connection
Worksheets(2).Select
LastRow = GetRowCnt
For bl = LastRow To 5 Step -1
myCon.ConnectionString = "Driver={SQL Server};Server=" & Server_Name & _
";Uid=" & User_ID & ";Pwd=" & Password & ";Database=" & Database_Name & ";"
myCon.Open
SQLStr = "SELECT [RTV_RESULT]" & _
"FROM [WSCZWMS].[WSCZWMS].[OMEGA_E2E_REPORT] WHERE [SME_TRACK_NO] ='" & Cells(bl, "CC").Value & "'"
Set myRes = myCon.Execute(SQLStr)
Worksheets("HelpTables").Range("E2" & Rows.Count).End(xlUp).Offset (1)
StrQuery = "OMEGA_SPEQ_REPORT"
myCon.Close
Set myRes = Nothing
Set myCon = Nothing
Next
End Sub
But when I run it, it writes Application-define or object-define error.
and colored this line
Worksheets("HelpTables").Range("E2" & Rows.Count).End(xlUp).Offset(1).CopyFromRecordset myRes
This line dave the select data into first empty row in column E, (start on 3rd row)
Do you have any idea how to solve this?
The reason for your issue is, that you are already referring to the Row in your .Range("E2" & Rows.Count) .
If you modify the mentioned line to the following, it should work properly:
Worksheets("HelpTables").Cells(Rows.Count, 5).End(xlUp).Offset(1).CopyFromRecordset myRes
The 5 in .Cells(Rows.Count, 5) is for the fifth column ('E').
I am not sure, but it seems that your excel objects Cells dans Rows should be affected and your sheets selected.
I would have writen
For b1=...
Worksheets(2).select
...
... Worksheets(2).cells(b1,"CC").value
...
Worksheets("HelpTables").select
Worksheets("HelpTables").Range("E" & _
Worksheets("HelpTables").Range("E:E").Rows.Count).End(xlUp).Offset(1) ...
...
NB :
"CC" is the name of a Excel value ?
Do you want Range("E2" & rows.count) to go to E2100 if there are 100 rows ? That's why I wrote "E" and not "E2" in my proposition. But may be you wanted (... rows.count+2) ?
Hope it helps.
Pierre.

DAO Recordset vs Numerous Dlookups

I created an access DB for a small business. In this DB I frequently auto fill some text boxes based on a key field via VBA using:
me.textboxvalue0.value = Nz(DLookup("VALUE0", "tblsomething", "lookedfield = '" & Me.keyfield.Value & "'"), "")
me.textboxvalue1.value = Nz(DLookup("VALUE1", "tblsomething", "lookedfield = '" & Me.keyfield.Value & "'"), "")
me.textboxvalue2.value = Nz(DLookup("VALUE2", "tblsomething", "lookedfield = '" & Me.keyfield.Value & "'"), "")
This piece of code repeats for all of my auto fillable textboxes ranging from 2 to 15 txtboxes.
My question is:
Is it faster to open a DAO recordset and find that particular row with all of its fields, or is it faster (execution time) to keep using multiple Dlookups to pull field by field of that row.
You can use the OnCurrent event of the form:
Dim rst As DAO.Recordset
Dim SQL As String
SQL = "Select * From tblSomething Where lookedfield = '" & Me!keyfield.Value & "'")
Set rst = CurrentDb.OpenRecordset(SQL)
If rst.RecordCount > 0 Then
Me!textboxvalue0.Value = rst!VALUE0.Value
Me!textboxvalue1.Value = rst!VALUE1.Value
Me!textboxvalue2.Value = rst!VALUE2.Value
Else
Me!textboxvalue0.Value = Null
Me!textboxvalue1.Value = Null
Me!textboxvalue2.Value = Null
End If
rst.Close
Set rst = Nothing

Storing Listbox Value Generated by a Row Source Query

I am trying to store the value of a listbox (Actual_Polygon_Area) that has been generated via row source query. Each time I run the script my message box tells me that the value of the listbox is null and I suspect it's caused by the row source. The suspected listbox is named Actual_Polygon_Area and the field I am trying to store it in is Polygon_Area within the table FS_Actual_Polygon.
Private Sub Actual_Polygon_Save_Click()
If IsNull(Actual_Polygon_Year) Then
MsgBox "Please enter a year in which this polygon received treatment"
Actual_Polygon_Year.SetFocus
ElseIf IsNull(Actual_Polygon_Season) Then
MsgBox "Please enter the season in which this polygon received treatment"
Actual_Polygon_Season.SetFocus
ElseIf IsNull(Actual_Polygon_Treatment) Then
MsgBox "Please select the treatment type that was completed in this polygon."
Actual_Polygon_Treatment.SetFocus
ElseIf IsNull(Actual_Polygon_Notes) Then
MsgBox "Please write a short summary regarding treatment goals and objectives."
Actual_Polygon_Notes.SetFocus
ElseIf IsNull(Actual_Polygon_Area) Then
MsgBox "Polygon Area is null, please enter a value"
Actual_Polygon_Area.SetFocus
Else
Dim MyConnection As ADODB.Connection
Set MyConnection = CurrentProject.Connection
Dim rsFS_Actual_Polygon As ADODB.Recordset
Set rsFS_Actual_Polygon = New ADODB.Recordset
If IsNull(PolygonNo) Then
'add
rsFS_Actual_Polygon.Open "select * from FS_Actual_Polygon where PolygonNo= " & Actual_Polygon_ID & " and Treatment_Season= '" & Actual_Polygon_Season & "' and Treatment_Type= '" & Actual_Polygon_Treatment & "' and Project_Name = '" & Actual_Polygon_Project_Name & "' and Polygon_Area = " & Actual_Polygon_Area.Value & " and Treatment_Year = " & Actual_Polygon_Year, _
MyConnection, adOpenDynamic, adLockOptimistic
If Not rsFS_Actual_Polygon.EOF Then
MsgBox "The combination of Polygon ID, treatment-year, treatment-season, and treatment type already exist. Please check the combination."
Actual_Polygon_Year.SetFocus
Else
With rsFS_Actual_Polygon
.AddNew
![PolygonID] = Actual_Polygon_ID
![Project_Name] = Actual_Polygon_Project_Name
![Polygon_Area] = Actual_Polygon_Area.Value
![Treatment_Year] = Actual_Polygon_Year
![Treatment_Season] = Actual_Polygon_Season
![Treatment_Type] = Actual_Polygon_Treatment
![Polygon_Notes] = Actual_Polygon_Notes
.Update
End With
Actual_Polygon_Record.Requery
Actual_Polygon_New_Click
End If
I can post the rest of the code if necessary, I just didn't want to post a huge chunk.
You can use the .ItemsSelected and .ItemData methods to find and pass the value of the selected row from the listbox to your table.
This is a fairly typical use of the listbox control, and is a little easier than dealing with a multi-select control, but is still a bit cumbersome. You will need to create a For Each...Next loop to collect the row number of the selected row in your listbox and save to a variable. Then use that variable as the argument of the .ItemData method to return the bound column value for that selected row.
This MSDN article should have everything you need.
EDIT: While the above solution works for multi and single select listboxes, there is a more expedient way for single select listboxes:
Dim i as Integer
i = Me!Actual_Polygon_Area.ListIndex
If i = -1 Then
MsgBox "No item has been selected"
Exit Sub
End If
'Do above prior to `WITH` loop
...'Then in your `WITH` loop:
![Polygon_Area] = Actual_Polygon_Area.ItemData(i)

How to make comparison report in crystal report

I am having a problem in making a report to show the comparison between present transaction result and its future impact result
i am using vb.net and i am displaying the report using the values in the data table and so far my data table shows record like this.
In this record f_id = 1 in both purchase and sale transaction and it will increment on both if there are more transaction.
I have to display the purchase transaction which has f_id = 1 on the left and other on the right side.Image 3 will tells you what am trying to say
currently my reports are displaying like this
but i want to display the report in this style so that its much more easier to compare between the two.
here is my code that prints the data on the report
Private Sub FutureTransaction()
Dim sql = "SELECT client.cl_cname, company.co_sname, invmast.im_qty, invmast.im_rate, invmast.im_tdate,invmast.im_crate,invmast.im_tax,invmast.f_type,invmast.f_id"
Sql += " FROM invmast "
sql += "INNER JOIN company ON invmast.co_scode = company.co_scode "
sql += "INNER JOIN client ON invmast.cl_ccode = client.cl_ccode and"
sql += " invmast.fn_code = client.fn_code"
sql += " where invmast.im_tdate>='" & dtpFromDate.Value.ToString("dd-MMM-yyyy") & "' and invmast.im_tdate <= '" & dtpToDate.Value.ToString("dd-MMM-yyyy") & "'"
sql += " and invmast.f_type = 1 and im_qty > 0"
sql += "ORDER BY invmast.f_id"
Dim dt As New DataTable
Dim da = New SqlDataAdapter(sql, cnMain)
da.Fill(dt)
Dim rpt As New FutureTransaction
'Dim rptt As New FutureTransaction()
rpt.DataDefinition.FormulaFields("FundName").Text = "'" & FundName & "'"
rpt.DataDefinition.FormulaFields("FromDate").Text = "'" & dtpFromDate.Value.ToString("dd-MMM-yyyy") & "'"
rpt.DataDefinition.FormulaFields("ToDate").Text = "'" & dtpToDate.Value.ToString("dd-MMM-yyyy") & "'"
rpt.Refresh()
frmReportViewer.crvMain.ReportSource = rpt
frmReportViewer.crvMain.Refresh()
frmReportViewer.Show()
End Sub
So hope you guys will help me out.

find the duplicate and write it in log file

I have craeted code which reads the acc no, rtn, name and amt from text file and stores in recordset. After that i created sql that stores recordset data into sql server 2005 table.
The problem is In that accno column is primary key. but i have some duplicate accno in my text file. While adding recordset to database, if it finds duplicate accno it is stopping there and not inserting any rows after that duplicate column.
Now i what i want to do is if there is any duplicate column, i want to store that column into log file and skip that column and insert remaining columns into databse. I dont know how to do it. Can anybody help me. like how to check the duplicate column and skip that and insert remaining.
' Write records to Database
frmDNELoad.lblStatus.Caption = "Loading data into database......"
Dim lngRecCount As Long
lngRecCount = 0
rcdDNE.MoveFirst
With cmdCommand
.ActiveConnection = objConn
.CommandText = "insert into t_DATA_DneFrc (RTN, AccountNbr, FirstName, MiddleName, LastName, Amount) values ('" & rcdDNE("RTN") & "', '" & rcdDNE("AccountNbr") & "', '" & rcdDNE("FirstName") & "', '" & rcdDNE("MiddleName") & "', '" & rcdDNE("LastName") & "', '" & rcdDNE("Amount") & "')"
.CommandType = adCmdText
End With
Set rcddnefrc = New ADODB.Recordset
With rcddnefrc
.ActiveConnection = objConn
.Source = "SELECT * FROM T_DATA_DNEFRC"
.CursorType = adOpenDynamic
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.Open
End With
Do Until rcdDNE.EOF
lngRecCount = lngRecCount + 1
frmDNELoad.lblStatus.Caption = "Adding record " & lngRecCount & " of " & rcdDNE.RecordCount & " to database."
frmDNELoad.Refresh
DoEvents
Call CommitNew
rcdDNE.MoveNext
Loop
frmDNELoad.lblStatus.Caption = "DNE Processing Complete."
frmDNELoad.Refresh
End Function
Sub CommitNew()
' Add records to DneFrc table
With rcddnefrc
.Requery
.AddNew
.Fields![RTN] = rcdDNE.Fields![RTN]
.Fields![AccountNbr] = rcdDNE.Fields![AccountNbr]
.Fields![FirstName] = rcdDNE.Fields![FirstName]
.Fields![MiddleName] = rcdDNE.Fields![MiddleName]
.Fields![LastName] = rcdDNE.Fields![LastName]
.Fields![Amount] = rcdDNE.Fields![Amount]
.Update
End With
End Sub
More of a strategy then a specific answer but ...
When importing data from external sources we'll often insert the data into staging tables that do not have the same keys/contraints placed on them and then sanitize the data prior to insertion.
What is done during "sanitation" depends on your requirements (for example, when you have two of the same account numbers are the records the same or are the data fields different, if the fields are different, how do you choose which data to use?). And then insert/move it into the production table once sanitization is complete.
I ran into this problem and what I did is to make a collection that I stored the object and the key into the Key. If I try to add a duplicated key I get an error.
This is the easyest way I found to do this in vb6. in c# is dictionary.
My suggestion would be to add error handling to CommitNew to see if the row inserted would create a primary key violation, and if so then perform other handling.
Example:
Sub CommitNew()
''#Add records to DneFrc table
On Error GoTo CommitNew_Error
With rcddnefrc
.Requery
.AddNew
.Fields![RTN] = rcdDNE.Fields![RTN]
.Fields![AccountNbr] = rcdDNE.Fields![AccountNbr]
.Fields![FirstName] = rcdDNE.Fields![FirstName]
.Fields![MiddleName] = rcdDNE.Fields![MiddleName]
.Fields![LastName] = rcdDNE.Fields![LastName]
.Fields![Amount] = rcdDNE.Fields![Amount]
.Update
End With
Exit Sub ''# If no error, exit routine.
CommitNew_Error:
If Err.Number = -2147217873 Then
''# code here will only execute if the constraint violation occurs
Call WriteDuplicateAccountToFile()
Err.Clear() ''# This clears the error, since you handled it
Else
''# Do stuff with other errors.
''# If you're not sure, at least display what error its giving, like so
MsgBox "The following error was encountered when new record was saved:" & _
vbNewLine & CStr(Err.Number) & " - " & Err.Description & vbNewLine & _
"New record not saved.", vbOkOnly + vbCritical, "Error"
End If
End Sub

Resources