I hope someone can help me with this, I am new in SQL and this makes me confuse.
I want to find a specific/matched data in mySQL table via inputbox, This code only find data in the first row and doesn't recognize the second and the rest data in the row of my database..
here is my code..
Dim rs As New ADODB.Recordset
myConn
Dim holdstr As String
holdstr = InputBox("Enter Number")
rs.Open "SELECT * FROM lemployees ", conn
Do Until rs.EOF
If holdstr = "" Then
conn.Close
Exit Sub
End If
If holdstr = rs!ENumber Then
MsgBox "Record found!", vbInformation, "Message"
UserForm2.lblnum.Caption = rs!ENumber
UserForm2.TextBox2.Text = rs!ELName
UserForm2.TextBox3.Text = rs!EFName
UserForm2.TextBox4.Text = rs!EMName
UserForm2.boxPos = rs!EDepartment
UserForm2.TextBox6.Text = rs!EAge
UserForm2.TextBox7.Text = rs!EHourlyPaid
UserForm2.TextBox8.Text = rs!ECitizen
conn.Close
Exit Sub
Else
MsgBox "Record not found", vbInformation, "Message"
Exit Sub
End If
Loop
Thanks!
You exit the Sub inside the loop. Even if the item you are looking for is not found.
Try
Dim rs As New ADODB.Recordset
myConn
Dim holdstr As String
holdstr = InputBox("Enter Number")
If holdstr = "" Then
Exit Sub
End If
rs.Open "SELECT * FROM lemployees ", conn
Do Until rs.EOF
If holdstr = rs!ENumber Then
MsgBox "Record found!", vbInformation, "Message"
UserForm2.lblnum.Caption = rs!ENumber
UserForm2.TextBox2.Text = rs!ELName
UserForm2.TextBox3.Text = rs!EFName
UserForm2.TextBox4.Text = rs!EMName
UserForm2.boxPos = rs!EDepartment
UserForm2.TextBox6.Text = rs!EAge
UserForm2.TextBox7.Text = rs!EHourlyPaid
UserForm2.TextBox8.Text = rs!ECitizen
conn.Close
Exit Sub
End If
Loop
MsgBox "Record not found", vbInformation, "Message"
conn.Close
Exit Sub
Related
I have a code that is used to send emails using outlook from access. This code is throwing "Application-Defined or objected-Defined" error when the code is reaching .Recipient.Add line. This code works totally fine in my system but not in my colleague system. I have checked libraries and everything match but still the error is coming.
Private Sub Toggle182_Click()
On Error GoTo Err_Toggle182_Click
Dim BaCode As String
Dim lst As Control
Set lst = Me.name
Dim BillingMnth As String
BillingMnth = Format(Me.Billing_Month, "mmm")
Dim oItem As Variant
Dim iCount As Integer
Dim oApp As New Outlook.Application
Dim oEmail As Outlook.MailItem
Dim fileName As String
Dim sqry As String
Dim rs As DAO.Recordset
If lst.ItemsSelected.Count <> 0 Then
For Each oItem In lst.ItemsSelected
BaCode = lst.Column(0, oItem)
fileName = "My local path"
fileName = fileName & name & BillingMnth & ".xlsx"
sqry = "Select Distribution_List from details where name='" & name & "';"
Set rs = CurrentDb.OpenRecordset(sqry)
Set oEmail = oApp.CreateItem(olMailItem)
With oEmail
rs.MoveFirst
While Not rs.EOF
.Recipients.Add rs.Fields("Distribution_List")
rs.MoveNext
Wend
.Subject = "RTB"
.HTMLBody = "<HTML><BODY>Dear User <br><br> Please find the attached file. <br><br> Kindly do let us know in case of any concerns. <br> <br><br>Kind Regards, <br>company <br> </BODY></HTML>"
.Attachments.Add fileName
.Save
.Send
End With
iCount = iCount + 1
Next oItem
MsgBox "Email successfully sent!", vbInformation, "EMAIL STATUS"
Else
MsgBox "Please slect the name"
Exit Sub
End If
Err_Toggle182_Click:
'MsgBox Err.Description
End Sub
Possible that rs.Fields("Distribution_List") is null?
Try nz(rs.Fields("Distribution_List"),"") and see if it works.
I have built one database where the below audit trail code works flawlessly for both forms and sub-forms in Access 2010. But now that I am using it again in another database, I now get an error "Argument Not Optional" at the first Call. Why would this work in one database and not the other if they both have had the sub-form created the same exact way? I can not get the database to give me more information outside of the not so helpful error code. My best guess is that it has something to do with Sub TrainingEntryAuditChanges(IDField As String, UserAction As String, FormToAudit As Form) but I can't really tell. Like I said, it works in one database, but not this one for some reason. Any ideas?
Module Code:
***ABOVE CODE OMITTED INTENTIONALLY***
'Audit module code for employee training entry form's sub form
Sub TrainingEntryAuditChanges(IDField As String, UserAction As String, FormToAudit As Form)
On Error GoTo AuditChanges_Err
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim ctl As Control
Dim datTimeCheck As Date
Dim strUserID As String
Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
rst.Open "SELECT * FROM tblAuditTrail", cnn, adOpenDynamic, adLockOptimistic
datTimeCheck = Now()
strUserID = Forms!Login!cboUser.Column(1)
'Get computer IP address
Dim myWMI As Object, myobj As Object, itm
Set myWMI = GetObject("winmgmts:\\.\root\cimv2")
Set myobj = myWMI.ExecQuery("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled = True")
For Each itm In myobj
getMyIP = itm.IPAddress(0)
Next
'If user is editing an existing record:
Select Case UserAction
Case "EDIT"
For Each ctl In FormToAudit
If ctl.Tag = "Audit" Then
If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
With rst
.AddNew
![DateTime] = datTimeCheck
![UserName] = strUserID
![UserComputer] = getMyIP
![FormName] = FormToAudit.Name
![Action] = UserAction
![RecordID] = FormToAudit.Controls(IDField).Value
![FieldName] = ctl.ControlSource
![OldValue] = ctl.OldValue
![NewValue] = ctl.Value
.Update
End With
End If
End If
Next ctl
'If a user is creating a new record:
Case Else
With rst
.AddNew
![DateTime] = datTimeCheck
![UserName] = strUserID
![UserComputer] = getMyIP
![FormName] = FormToAudit.Name
![Action] = UserAction
![RecordID] = FormToAudit.Controls(IDField).Value
.Update
End With
End Select
AuditChanges_Exit:
On Error Resume Next
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
Exit Sub
'If error then:
AuditChanges_Err:
Dim strError As String
Dim lngError As Long
Dim intErl As Integer
Dim strMsg As String
strError = Err.Description
lngError = Err.Number
intErl = Erl
strMsg = "Line : " & intErl & vbCrLf & _
"Error : (" & lngError & ")" & strError
MsgBox strMsg, vbCritical
Resume AuditChanges_Exit
End Sub
Before_Update code on subform:
Private Sub Form_BeforeUpdate(Cancel As Integer)
If Me.NewRecord Then
Call TrainingEntryAuditChanges("ID", "NEW") ***ERROR THROWN HERE***
Else
Call TrainingEntryAuditChanges("ID", "EDIT")
End If
End Sub
The Argument Not Optional is thrown when you are calling a routine with the incorrect number of arguments required for that routine.
In your code
Sub TrainingEntryAuditChanges(IDField As String, UserAction As String, FormToAudit As Form)
requires three arguments, IDField, UserAction, and FormToAudit.
However, in your Call
Call TrainingEntryAuditChanges("ID", "NEW") ***ERROR THROWN HERE***
you are only passing it two arguments: ID, NEW. You need to pass it a third argument (which looks like it will be the form). Try using me as the third argument to pass the 'current' form that is being updated and therefore calling the routine.
How do I get all messages before showing a form, and display this form one by one?
First of all, I have a program that gets an entry if the "Client" is already checked out or if a reservation of a client has already expired. With this method, I will get their transaction number and client number in put their infos in a form and display it. Notice that I have a different form for EXPIRED RESERVATION and CHECK OUT
Can someone check my program? Here is my code for getting the client if his/her check in has expired.
Public Sub computeRemainingDaysForCheckedIns()
Dim computedDays As Integer
Dim dateNow As Date = Date.Now.ToString("yyyy-MM-dd")
Try
mysqlconn = New MySqlConnection(con)
mysqlconn.Open()
query = "select TransactionNumber, ClientNumber, DATEDIFF(dateout,curdate()) as 'ComputedDays' from dbo_transactions where ClientStatus = 'Checked In'"
cmd = New MySqlCommand(query, mysqlconn)
rd = cmd.ExecuteReader
If rd.HasRows Then
'hasRows ibig sabhin mayLAMAN ung table
While rd.Read
computedDays = rd.GetString("ComputedDays")
'Console.WriteLine(computedDays)
If computedDays > 0 Then
getTransactionNumber = ""
getClientNumber = ""
ElseIf computedDays < 0 Then
getTransactionNumber = rd.GetString("TransactionNumber")
getClientNumber = rd.GetString("ClientNumber")
iTitle = "CHECK OUT CLIENT."
iMessage.AppendLine("* Client: " & getClientNumber & ", Transaction: " & getTransactionNumber & " *")
isCNotifShowed = True
End If
End While
'notificationFormC.Show()
Else
'no data
End If
mysqlconn.Close()
Catch ex As Exception
isCNotifShowed = False
MsgBox("Something Went Wrong!" & vbNewLine &
ex.Message, MsgBoxStyle.Exclamation)
Finally
mysqlconn.Dispose()
End Try
End Sub
Public Sub computeRemainingDaysForReservations()
Dim computedDays As Integer
Try
mysqlconn = New MySqlConnection(con)
mysqlconn.Open()
query = "Select TransactionNumber, ClientNumber, DATEDIFF(DateIn, CURDATE()) as 'ComputedDays' from dbo_transactions where ClientStatus = 'Reserved'"
cmd = New MySqlCommand(query, mysqlconn)
rd = cmd.ExecuteReader
If rd.HasRows Then
'hasRows ibig sabhin mayLAMAN ung table
While rd.Read
computedDays = rd.GetString("ComputedDays")
'Console.WriteLine(computedDays)
If computedDays > 0 Then
getTransactionNumber = ""
getClientNumber = ""
ElseIf computedDays <= 0 Then
getTransactionNumber = rd.GetString("TransactionNumber")
getClientNumber = rd.GetString("ClientNumber")
iiTitle = "RESERVATION IS ALREADY EXPIRED."
iiMessage.AppendLine("* " & getClientNumber & ", Transaction: " & getTransactionNumber & " *")
isRNotifShowed = True
End If
End While
Else
'no data
End If
rd.Close()
mysqlconn.Close()
Catch ex As Exception
isRNotifShowed = False
MsgBox("Something Went Wrong!" & vbNewLine &
ex.Message, MsgBoxStyle.Exclamation)
Finally
mysqlconn.Dispose()
End Try
End Sub
then for displaying the client using a form
Private Sub RepeatProcess()
computeRemainingDaysForReservations()
computeRemainingDaysForCheckedIns()
If iMessage.Length <> 0 Then
ElseIf iiMessage.Length <> 0 Then
End If
'If isCNotifShowed = True Then
'notificationFormC.Show()
'ElseIf isRNotifShowed = True Then
' notificationFormR.Show()
'Else
'End If
End Sub
Private Sub timerTask_Tick_1(sender As Object, e As EventArgs) Handles timerTask.Tick
tCount += 1
If tCount = tSecs Then
Call RepeatProcess()
tCount = 0 'reset
End If
End Sub
Perhaps this is not the best way of doing this. Opening a new form/pop-up/whatever for every booking that is out of date could potentially suck up all of your resources.
I would recommend that you display a GridView, DataGrid, ListView or similar (we're still chiselling stone tablets out in VS2008, so I'm not sure what extremes of technology there are in more recent versions!). The code behind could be written to highlight the problem records in a different colour so that they are more obvious.
To do this you'd simply need to create a DataSource on your form with the relevant query(ies) then display the results in a the appropriate data enabled grid.
So in my database, I've got a junction table that lists all of the "purposes" someone has for a loan. The code worked when just showing the values (in number form), but in my second loop where I search a second table for the actual name of the purpose, I'm running into issues. It displays the correct number of purposes, but unfortunately, the text repeats the first found purpose that number of times rather than displaying all applicable purposes.
Here is the code I'm using:
Private Sub cmdMsgBox_Click()
Dim DB As Database
Dim tblOpp2LP As Recordset
Dim tblLoanPurpose As Recordset
Dim ctlFindRecord As Control
Dim lngHoldOpportunityID As Variant
Dim intRecordCount As Integer
Dim valTestBox As String
Dim valLP As String
Dim valName As String
Set DB = CurrentDb
Set tblInputOpp2LP = DB.OpenRecordset("Opp2LP")
Set tblLoanPurpose = DB.OpenRecordset("LoanPurpose")
Set ctlFindRecord = Me.ctlFindRecord
lngHoldOpportunityID = CLng(ctlFindRecord)
valTestBox = ""
On Error GoTo ErrorHandling_Err:
tblInputOpp2LP.FindFirst "[OpportunityID] = " & lngHoldOpportunityID
If tblInputOpp2LP.NoMatch Then
MsgBox "No Matching Record Found"
Exit Sub
Else
Do Until tblInputOpp2LP.EOF
If lngHoldOpportunityID = tblInputOpp2LP![OpportunityID] Then
valLP = tblInputOpp2LP![LPID]
intCounter = intCounter + 1
Do Until tblLoanPurpose.EOF
If valLP = tblLoanPurpose![LPID] Then
valName = tblLoanPurpose![Name]
End If
tblLoanPurpose.MoveNext
Loop
If valTestBox = "" Then
valTestBox = valName
Else
valTestBox = valTestBox & ", " & valName
End If
End If
tblInputOpp2LP.MoveNext
Loop
txtMsgbox = valTestBox
End If
ErrorHandling_Exit:
Exit Sub
ErrorHandling_Err:
MsgBox Err.Description & " - " & Err.Number
Resume ErrorHandling_Exit
End Sub
Thoughts? Thanks in advance!
I got it!
As it turns out, what I needed to do was add an "exit do" in the second loop.
See the below code example.
Private Sub cmdMsgBox_Click()
Dim DB As Database
Dim tblOpp2LP As Recordset
Dim tblLoanPurpose As Recordset
Dim ctlFindRecord As Control
Dim lngHoldOpportunityID As Variant
Dim intRecordCount As Integer
Dim valTestBox As String
Dim valLP As String
Dim valName As String
Set DB = CurrentDb
Set tblInputOpp2LP = DB.OpenRecordset("Opp2LP")
Set tblLoanPurpose = DB.OpenRecordset("LoanPurpose")
Set ctlFindRecord = Me.ctlFindRecord
lngHoldOpportunityID = CLng(ctlFindRecord)
valTestBox = ""
On Error GoTo ErrorHandling_Err:
tblInputOpp2LP.FindFirst "[OpportunityID] = " & lngHoldOpportunityID
If tblInputOpp2LP.NoMatch Then
MsgBox "No Matching Record Found"
Exit Sub
Else
Do Until tblInputOpp2LP.EOF
If lngHoldOpportunityID = tblInputOpp2LP![OpportunityID] Then
valLP = tblInputOpp2LP![LPID]
intCounter = intCounter + 1
Do Until tblLoanPurpose.EOF
If valLP = tblLoanPurpose![LPID] Then
valName = tblLoanPurpose![Name]
exit do
End If
tblLoanPurpose.MoveNext
Loop
If valTestBox = "" Then
valTestBox = valName
Else
valTestBox = valTestBox & ", " & valName
End If
End If
tblInputOpp2LP.MoveNext
Loop
txtMsgbox = valTestBox
End If
ErrorHandling_Exit:
Exit Sub
ErrorHandling_Err:
MsgBox Err.Description & " - " & Err.Number
Resume ErrorHandling_Exit
End Sub
I need to load files eg excel, word etc documents to SQL Server 2008 so that they can be viewable/downloadable from a website. I need to be able to load and open the files from the access database and website.
Can anyone help, thank you.
Here is how I did it in an old project. You can strip away the progress bar stuff and some of the other stuff but you get the idea
Public Sub Upload_file_OLD(lMaterial_ID As Long, strFile_name As String)
'upload the file to the selected material ID.
Dim adStream As ADODB.Stream
Dim rst As ADODB.Recordset
On Error GoTo Error_trap
'check if we have an open connection, if we do use it
Select Case dbCon.State
Case adStateOpen
'connection is open, do nothing
Case adStateConnecting
'still conecting wait
Do Until dbCon.State = adStateOpen
Application.Echo True, "Connection to DB"
Loop
Case adStateClosed
'connection closed, try to open it
If Len(strSQL_con_string) = 0 Then
Set_SQL_con "MCTS"
End If
dbCon.ConnectionString = strSQL_con_string
dbCon.Provider = "sqloledb"
dbCon.Open
End Select
Me.acxProg_bar.Value = 0
Me.acxProg_bar.Visible = True
Me.Repaint
Set adStream = New ADODB.Stream
adStream.Type = adTypeBinary
adStream.Open
Me.acxProg_bar.Value = 10
Me.Repaint
adStream.LoadFromFile strFile_name
Me.acxProg_bar.Value = 50
Me.Repaint
Set rst = New ADODB.Recordset
rst.Open "SELECT Material_FS,Material_file_name, Material_size FROM tblMaterials WHERE Material_ID=" & lMaterial_ID, dbCon, adOpenKeyset, adLockOptimistic
Me.acxProg_bar.Value = 60
Me.Repaint
Me.txtFile_size = adStream.Size
rst.Fields("Material_FS").Value = adStream.Read
rst.Fields("Material_file_name").Value = GetFileName(strFile_name)
rst.Fields("Material_size").Value = adStream.Size
Me.acxProg_bar.Value = 90
Me.Repaint
rst.Update
rst.Close
dbCon.Close
Me.acxProg_bar.Value = 0
Me.acxProg_bar.Visible = False
Me.Repaint
Exit Sub
Error_trap:
If dbCon Is Nothing = False Then
If dbCon.State = adStateOpen Then dbCon.Close
End If
DoCmd.Hourglass False
MsgBox "An error happened in sub Upload_file, error description, " & Err.Description, vbCritical, "MCTS"
End Sub
I could not get the above code to work, but I did get this to work. SQL Server blob field is varbinary(max).
Upload:
Sub TestDocUpload()
Dim cmd As New ADODB.Command
Dim st As New ADODB.Stream
st.Type = adTypeBinary
st.Open
st.LoadFromFile "c:\temparea\18572.pdf"
With cmd
.CommandText = "Insert into tbldocuments(docblob, doctype) values (?, ?)"
.CommandType = adCmdText
.Parameters.Append .CreateParameter("#P1", adLongVarBinary, adParamInput, st.Size, st.Read)
.Parameters.Append .CreateParameter("#P2", adVarChar, adParamInput, 50, "CustPO")
End With
If cnlocal.State = 0 Then OpenNewLocalConnection
cmd.ActiveConnection = cnlocal
cmd.Execute
End Sub
Retrieve:
Sub TestReadDoc()
Dim myblob() As Byte
Dim rs As New ADODB.Recordset
If cnlocal.State = 0 Then OpenNewLocalConnection
rs.Open "tblDocuments", cnlocal, adOpenForwardOnly, adLockReadOnly
rs.MoveFirst
myblob = rs!DocBlob
Open "c:\temparea\output.pdf" For Binary Access Write As 1
Put #1, , myblob
Close #1
End Sub