i wanna test pass by reference and pass by value in access, but it doesn't work.
Sub passByRef(ByRef a As Integer)
a = a + 1
End Sub
Sub passByVal(ByVal a As Integer)
a = a + 1
End Sub
Private Sub cmdByRef()
Dim i as Integer
i = 10
passByRef i
MsgBox i
End Sub
Private Sub cmdByVal()
Dim i as Integer
i = 10
passByVal i
MsgBox i
End Sub
in the pass by ref it does not state that it is the pass by reference function. Any idea?
maybe you should do this.
Private Sub cmdByRef()
Dim i as Integer
i = 10
passByRef i
MsgBox "Result of passByRef " + i
End Sub
Private Sub cmdByVal()
Dim i as Integer
i = 10
passByVal i
MsgBox "Result of passByVal " + i
End Sub
Related
I have the below code used to capture the selected values from listbox in msaccess. All I'm getting is only the index value but not the actual value which is a string value.
eg. if my listbox contains values like XXX,AAA,BBB and if i select XXX the code is fetching the index value of XXX as 0 and using it every where. But my expectation is to capture and store XXX as value.
Private Sub Create_Invoice_Click()
On Error GoTo Err_Create_Invoice_Click
Dim xlWorksheetPath As String
Dim dbTable As String
Dim dbTablee As String
Dim BaCode As String
Dim lst As ListBox
Set lst = Me.BA_CD
Dim rowcount As Long
Dim oItem As Variant
Dim iCount As Integer
If lst.ItemsSelected.Count <> 0 Then
For Each oItem In lst.ItemsSelected
If iCount = 0 Then
BaCode = BaCode & lst.ItemData(oItem)
iCount = iCount + 1
Else
BaCode = BaCode & "," & lst.ItemData(oItem)
iCount = iCount + 1
End If
Next oItem
Else
MsgBox "Nothing was selected from the list"
Exit Sub 'Nothing was selected
End If
xlWorksheetPath = "systempath\"
xlWorksheetPath = xlWorksheetPath & BaCode & ".xls"
dbTable = "table1"
dbTablee = "table2"
DoCmd.TransferSpreadsheet transfertype:=acExport, spreadsheettype:=acSpreadsheetTypeExcel12, tablename:=dbTable, filename:=xlWorksheetPath, hasfieldnames:=True
DoCmd.TransferSpreadsheet transfertype:=acExport, spreadsheettype:=acSpreadsheetTypeExcel12, tablename:=dbTablee, filename:=xlWorksheetPath, hasfieldnames:=True
MsgBox "Data trasfered successfully"
Exit_Create_Invoice_Click:
Exit Sub
Err_Create_Invoice_Click:
MsgBox Err.Description`enter code here`
Resume Exit_Create_Invoice_Click
End Sub
In the listbox, column 0 should be the ID of the selected value, and is the value being selected with lst.ItemData(oItem).
Column 1 would be the first visible value in the list.
Try changing lst.ItemData(oItem) to lst.Column(1, oItem)
The issue I am having is connect my Save_Record (suppose to save and push info) & btnExit (saves & exits) to push the information inputted on the form to be pushed out to the web database. The only way it will push the information is if I exit out, come back in and make a small change then it will push it out.
How can I achieve this without doing this?
Option Compare Database
Option Explicit
'-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**
Private Sub btnCancel_Click() '==**== undo changes
On Error Resume Next
RunCommand acCmdUndo
Err = 0
End Sub
'-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**
Private Sub btnExit_Click()
DoCmd.Close
End Sub
Private Sub cmdViewPDF_Click()
On Error GoTo Err_cmdViewPDF_Click
Dim stDocName As String
Dim stLinkCriteria As String
stDocName = "frm_Images"
DoCmd.OpenForm stDocName, , , stLinkCriteria
Exit_cmdViewPDF_Click:
Exit Sub
Err_cmdViewPDF_Click:
MsgBox Err.Description
Resume Exit_cmdViewPDF_Click
End Sub
'-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**
Private Sub Form_AfterUpdate()
'DoCmd.Save
End Sub
Private Sub Form_BeforeUpdate(Cancel As Integer)
[DT_MOD] = Now()
[MstrWinUser] = Forms!frFilter!txtWinUser
End Sub
'-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**
Private Sub MOREoperInfo_Click()
Dim DocName As String
Dim LinkCriteria As String
DoCmd.Save
DocName = "frmsearch"
DoCmd.OpenForm DocName, , , LinkCriteria
End Sub
'-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**
'Save record and close
Private Sub Save_Record_Click()
On Error GoTo Err_Save_Record_Click
[DT_MOD] = Now()
[MstrWinUser] = Forms!frmFilter!txtWinUser
'MsgBox "Saving frm_View"
'Save the record
'If there was a record already in txt box, we will assume it has been created in web
If Trim(txtEOCIncident.Value & vbNullString) = vbNullString Then
Me.txtEOCPushFlag = "0"
RunCommand acCmdSaveRecord
DoCmd.Save
Else
'SET EOC PUSH FLAG
Me.txtEOCPushFlag = "1"
RunCommand acCmdSaveRecord
DoCmd.Save
'TRY TO UPDATE WEB DATA
If (pushEOCData(Me.ID)) Then
'CLEAR PUSH FLAG AND SET PUSHDATE
Me.txtEOCPushFlag = "0"
Me.txtEOCPushDate = Now()
RunCommand acCmdSaveRecord
DoCmd.Save
End If
End If
Exit_Save_Record_Click:
Exit Sub
Err_Save_Record_Click:
MsgBox Error$
Resume Exit_Save_Record_Click
End Sub
'*** 08-20-13 New code. Creates PDF of the Report.
Private Sub btnSaveasPDF_Click()
On Error GoTo Err_btnSaveasPDF_Click
Dim db As Database, rs As Recordset
Dim vFN As String, vPATH As String, vFile As String
Dim blRet As Boolean
Dim stDocName As String
Dim strConstantName As String
stDocName = "rpt_Out"
'added 2014-09-02, MAB
strConstantName = "REPORT_FOLDER"
vPATH = Trim(DLookup("[ConstantValue]", "dbo_Constants", "[ConstantName] = '" & [strConstantName] & "'"))
If Forms!frm_View![DIST] = "1" Or Forms!frm_View![DIST] = "2" Or Forms!frm_View![DIST] = "3" Or Forms!frm_View![DIST] = "4" Then
vFN = Forms!frm_View![ID] & "_" & Forms!frm_View![Typeofreport] & "_" & Month(Now()) & "_" & Day(Now()) & "_" & Year(Now()) & "_" & Hour(Now()) & Minute(Now()) & ".pdf"
'vPATH = "\\...\...\Reports\"
vFile = vPATH & vFN
Else
MsgBox "Please enter your number." & vbCrLf & "It must be a single digit.", vbOKOnly Or vbInformation, "*****"
End If
'write to IMAGES
Set db = CurrentDb
Set rs = db.OpenRecordset("IMAGES")
rs.AddNew
rs!SPL_FILENAME = vFN
rs!SPL_ID = [Forms]![frm_View]![ID]
rs!SPL_MOD_DT = Format$(Now(), "mm/dd/yyyy")
rs!SPL_DOC_TYP = Forms!frm_View![DOC_TYP]
rs!SPL_FILELOC = vFile
rs!SPL_ACTIVE = "-1"
rs.Update
rs.Close
DoCmd.OpenReport "rpt_OUT", acViewPreview
DoCmd.OutputTo acReport, stDocName, acFormatPDF, vFile
MsgBox "An image of this report has been saved.", vbOKOnly Or vbInformation, "*****"
Exit_btnSaveasPDF_Click:
Exit Sub
Err_btnSaveasPDF_Click:
MsgBox Err.Description
Resume Exit_btnSaveasPDF_Click
End Sub
********************PUSHEOCDATA*******************************************
'* iSpillID is the value of SPILL_ID from Spills table for the
'* the record you want to update
'*
'*******************************************************************************
Public Function pushEOCData(iSpillID As Integer) As Boolean
Dim db As Database
Dim sSql As String
Dim strStoredProcSql As String
Dim qdef As DAO.QueryDef
Dim sEOCIncident As String
Dim rs As Recordset
Dim iEOCSpillID, iEOCMat1ID, iEOCMat2ID As Long
Dim iReturn As Integer
Dim dAmount1 As Double
Dim dAmount2 As Double
Dim sSpillResponse As String
Dim sMaterialResponse As String
Dim sEOCSpillID, sEOCMat1ID, sEOCMat2ID As String
Dim iFoundAt As Long
Dim iStart As Long
Dim sTemp As String
Dim bReturn As Boolean
Dim objSpillNode As IXMLDOMNode
Dim objMaterialsNodes As IXMLDOMNodeList
Dim objMaterialNode As IXMLDOMNode
pushEOCData = True
initWEBEoc
iEOCSpillID = -1
iEOCMat1ID = -1
iEOCMat2ID = -1
'RETRIEVE INCIDENT NUMBER FROM DATABASE and associated data
'from the database. Note: this is a stored procedure
Set db = CurrentDb
Set qdef = CurrentDb.CreateQueryDef("")
qdef.Connect = CurrentDb.TableDefs("usysWellHistory").Connect
qdef.ReturnsRecords = True
'
' This stored procedure is written to return a record set with
' fields named the same as in webeoc.
'
'strStoredProcSql = "EXEC RBDMS.SPILL_QUERY #N_SPILLID=" & iSpillID
strStoredProcSql = "{CALL RBDMS.SPILL_QUERY (" & iSpillID & ")}"
qdef.sql = strStoredProcSql
Set rs = qdef.OpenRecordset
'Check to see if the recordset actually contains rows
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst 'Unnecessary in this case, but still a good habit
sEOCIncident = rs!INCIDENTID_NUMBER
If Len(sEOCIncident) < 1 Then
pushEOCData = False
Exit Function
End If
'Get the data from webeoc.
'business rules say that we have to have data
'in webeoc to continue
iReturn = getSpillNode(sEOCIncident, objSpillNode)
If iReturn < 1 Then
'MsgBox "No WEBEoc data exists for EOC Incident: " & sEOCIncident
pushEOCData = False
Exit Function
End If
'grab the data id from the spill data, we will need this later to
'update the materials
sEOCSpillID = objSpillNode.Attributes.getNamedItem("dataid").Text
iEOCSpillID = CLng(sEOCSpillID)
If iEOCSpillID < 1 Then
pushEOCData = False
Exit Function
End If
bReturn = updateEOCSpillData(rs, objSpillNode)
If bReturn = False Then
pushEOCData = False
Exit Function
End If
dAmount1 = rs!AMOUNT1
dAmount2 = rs!AMOUNT2
'Get the materials records from webeoc for this incident number.
iResult = getMaterialNodes(sEOCSpillID, objMaterialsNodes)
If dAmount1 > 0 Then
'If webeoc has one or more materials records for the incident,
'grab the first record and update it with dbase values
If objMaterialsNodes.LENGTH > 0 Then
Set objSpillNode = objMaterialsNodes.Item(0)
'update materials
updateEOCMaterialData rs, objSpillNode, 1
Else
'insert materials
insertEOCMaterialData rs, 1, sEOCSpillID
End If
End If
If dAmount2 > 0 Then
'if webeoc has more than one materials record for the incident,
'grab the second record and update it.
If objMaterialsNodes.LENGTH > 1 Then
Set objSpillNode = objMaterialsNodes.Item(1)
'update materials
updateEOCMaterialData rs, objSpillNode, 2
Else
'insert materials
insertEOCMaterialData rs, 2, sEOCSpillID
End If
End If
Else
'MsgBox "No data needs to be pushed to webeoc for this spill."
pushEOCData = True
Exit Function
End If
rs.Close
End Function
I beg the idea to handle query data with better speed. Already tried using, index or Store Procedures, but still often do not get the value of the data (the data some time empty).
Table (tbl_Phonebook) contains thousands of data that contains the phone number and name of the owner of the phone.
Thank You
This is MyCode:
Private Sub FrmLogger_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
Timer1.Interval = 50
Timer1.Enabled = True
End Sub
Private Sub Timer1_Tick(sender As System.Object, e As System.EventArgs) Handles Timer1.Tick
'check data (phonenumber) in ChannelData
For i = 0 To 31 'length of objChannelData
If objChannelData(i) <> "" Then
DataGridView1.Rows(i).Cells.Item(1).Value() = objChannelData(i) 'the value is PhoneNumber
DataGridView1.Rows(i).Cells.Item(2).Value() = GetPhoneBookName(objChannelData(i)) ' try to get Name of PhoneNumber owner
End If
Next
End Sub
Private Function GetPhoneBookName(ByVal nPhoneNumber As String) As String
'check db connection
Try
If (Conn_MySQL.State = ConnectionState.Closed) Then
Conn_MySQL.Open()
End If
'get value from table
Dim strSQL As String = "select fPhoneName from tbl_Phonebook where fPhoneNumber = '" & nPhoneNumber & "'"
Dim myCommand As New MySqlCommand(strSQL, Conn_MySQL)
Dim myReader As MySqlDataReader
myReader = myCommand.ExecuteReader()
myReader.Read()
If myReader.HasRows Then
If Not IsDBNull(myReader.GetValue(0)) Then
Return myReader.GetString(0)
Else
Return ""
End If
myReader.Close()
Else
Return ""
End If
Catch ex As Exception
Return ""
End Try
End Function
I have problem when i'm trying to fetch data from mysql database
I always get the last record.
How can I get all records showing on the datagridview synchronously
Here is my code
Please can someone help me
Public Class Form1
Private RowCount As Integer = 0
Private Sub bgw_ProgressChanged(ByVal sender As Object, ByVal e As System.ComponentModel.ProgressChangedEventArgs) Handles BackgroundWorker1.ProgressChanged
ListBox1.Items.Add(e.UserState)
ProgressBar1.Value = e.ProgressPercentage
Label1.Text = "Processing row.. " + e.ProgressPercentage.ToString()
DataGridView1.Rows.Add(New Object() {f1, f2})
Me.ProgressBar1.Maximum = RowCount
End Sub
Dim ListText As String
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles go.Click
go.Enabled = False
cancel.Enabled = True
ListBox1.Items.Clear()
ProgressBar1.Value = 0
BackgroundWorker1.WorkerReportsProgress = True
BackgroundWorker1.WorkerSupportsCancellation = True
BackgroundWorker1.RunWorkerAsync()
Me.Cursor = Cursors.WaitCursor
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cancel.Click
BackgroundWorker1.CancelAsync()
End Sub
Private Sub bgw_RunWorkerCompleted(ByVal sender As Object, ByVal e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles BackgroundWorker1.RunWorkerCompleted
go.Enabled = True
cancel.Enabled = False
Me.Cursor = Cursors.Arrow
DataGridView1.Refresh()
DataGridView1.CurrentCell = DataGridView1(0, DataGridView1.Rows.Count - 1)
End Sub
Dim f1 As String
Dim f2 As String
Dim ds As New DataSet
Dim command As MySqlCommand
Dim reader As MySqlDataReader
Private Sub BackgroundWorker1_DoWork(ByVal sender As System.Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
GetRecordCount()
Dim connetionString As String
Dim connection As MySqlConnection
Dim i As Integer = 0
Dim sql As String
connetionString = "Server=db4free.net;User Id=mouhcindinaoui;Password=$$$$$$;Database=mouhcindinaoui"
sql = "SELECT id,nom FROM dep02 "
connection = New MySqlConnection(connetionString)
Try
connection.Open()
command = New MySqlCommand(sql, connection)
reader = command.ExecuteReader()
For Value As Integer = 0 To rowcount
If reader.HasRows Then
Do While reader.Read()
f1 = reader.GetString("id")
f2 = reader.GetString("nom")
Loop
End If
ListText = String.Concat("Sequence #", Value)
BackgroundWorker1.ReportProgress(Value, ListText)
Thread.Sleep(10)
Next
reader.Close()
command.Dispose()
connection.Close()
Catch ex As Exception
' MsgBox("Can not open connection ! ")
End Try
End Sub
Private Sub GetRecordCount()
Dim connetionString As String
Dim connection As MySqlConnection
Dim command As MySqlCommand
Dim sql As String
connetionString = "Server=db4free.net;User Id=mouhcindinaoui;Password=dinaouimouhcin1991;Database=mouhcindinaoui"
sql = "Select count(*) from dep02"
connection = New MySqlConnection(connetionString)
command = New MySqlCommand(sql, connection)
connection.Open()
RowCount = CInt(command.ExecuteScalar())
End Sub
End Class
You are calling ReportProgress only at the end of the loop on the DataReader. Of course, at that point the two variables f1 and f2 used to set items in your grid contain the value of the last record read by the DataReader.
You need to move the call inside the DataReader loop
For Value As Integer = 0 To rowcount
If reader.HasRows Then
Do While reader.Read()
f1 = reader.GetString("id")
f2 = reader.GetString("nom")
ListText = String.Concat("Sequence #", Value)
BackgroundWorker1.ReportProgress(Value, ListText)
Loop
End If
Thread.Sleep(10)
Next
However it is totally useless the call to GetRecordCount and the external loop on the rowcount variable (and plain wrong). The while loop on the DataReader doesn't need it and your could remove all of it replacing everything with a simple increment of a local variable to keep the progressive of the current record inside the datareader loop
Dim recNum = 1
If reader.HasRows Then
Do While reader.Read()
f1 = reader.GetString("id")
f2 = reader.GetString("nom")
ListText = String.Concat("Sequence #", recNum)
BackgroundWorker1.ReportProgress(Value, ListText)
recNum = recNum + 1
Loop
End If
i have an access form consisting of a textbox , i need to check the last word of it and if this word is one of many words (array or a table column ) do an action , and this check will occurs in after_update event , something like
Private Sub textbox_AfterUpdate()
Dim txt As String
Dim lastword As String
txt = TextBox.Value
lastword= Right(txt, Len(txt) - InStrRev(txt, " "))
if lastword in (array() or column in a table) then
' do an action
End If
End Sub
we can also us an external function , could you help me with it ??
Looks like you got the function for the last word already... Now for the search in an array and table use this:
Function isInArray(stringToBeFound As String, arr As Variant) As Boolean
IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function
and
Function isColumnName(stringToBeFound As String, tableName As String) As Boolean
Dim db As Database
Dim rs1 As DAO.Recordset
Set db = CurrentDb()
Set rs1 = db.OpenRecordset(tableName)
isColumnName = False
Dim fld As DAO.Field
do until rs1.EOF
if rs1.Fields.Item(0).Value = stringToBeFound then
isColumnName = true
exit loop
end if
rs1.moveNext
loop
Set fld = Nothing
End Function
usage:
if isInArray(lastWord, youArray) or isColumnName(lastWord, "yourTable")
MsgBox "The word is already used!"
end if
How about something like this:
Private Sub TextBox1_AfterUpdate()
Dim txtStr As String
Dim vWords, v
txtStr = TextBox1.Text
If InStr(txtStr, " ") > 0 Then
txtStr = Right(txtStr, Len(txt) - InStrRev(txt, " "))
End If
vWords = Split("word1 word2 word3 word4", " ") ' fill vWords with the words you need
For Each v In vWords
If v = txtStr Then
' do an action
Exit For
End If
Next
End Sub