I have a simply MS Access database (version 2010) with just 4 fields:
Name of DB: Test
test1 = Text
test2 = yes/no (tick boxes)
test3 = Text
test4 = Text
I then created a formular named Form_Test and assigned code to the tick box:
Option Compare Database
Option Explicit
Private Declare Function apiGetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, _
nSize As Long) As Long
Function BenutzerName() As String
Dim lngLen As Long
Dim lngX As Long
Dim strBenutzerName As String
strBenutzerName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strBenutzerName, lngLen)
If lngX <> 0 Then
BenutzerName = Left$(strBenutzerName, lngLen)
Else
BenutzerName = ""
End If
End Function
Private Sub test2_Click()
If test2.Value = True Then
test3 = BenutzerName()
Else
test3 = ""
End If
End Sub
I want to use this code to add the username to the field test3 once the user clicked the tick box in any of the rows. However, the script does not work and I do not understand why. Can anyone help please?
Make sure your code is in right place,
In the Design mode of the form
Right click the Check box and select Properties -> Event Tab->On Click->Code Builder
will open the code editor
That's where your on code must reside
Edit:
In addition, Follow this link to set Breakpoint(F9) in your code to see if your code is being triggered , the link also contains information about debugging.
Related
This is my code:
Private Sub Form_Current()
Set rs = CurrentDb.OpenRecordset("Sites", dbOpenDynaset, dbSeeChanges)
rs.Requery
rs.MoveFirst
If Nz(Me.Site_ID.Value) > 0 Then
Me.H2OBillingIDlbl.Caption = DLookup("H2OBillingIDNum", "Sites", "H2OBillingIDNum = " & Me.txtHotelID)
Else
Me.H2OBillingIDlbl.Caption = ""
End If
End Sub
The DLookup line is throwing the error.
Me.txtHotelID box is a text entry box on the form and is used to enter numbers only.
The H2OBillingIDNum field in the recordset is Long.
I have tried putting brackets around H2OBillingIDNum; .Value at the end of H2OBillingIDNum and Me.txtHotelID alternatively and combined; entering the data as a string in which case I get data mismatch error.
I don't believe I can use a SQL query because it is a text entry field, but if I'm wrong, I'll happily take the information as I've never heard of a SQL query like that and it's a faster and more accurate method of pulling the data.
I'm out of ideas. Any suggestions? Is it the NZ? Is there a better way of writing that? Should that not be included at all? If it helps, this is a DAO db.
The error must be that Me.txtHotelID is empty, therefore your DLookup call is incomplete
DLookup("foo", "bar", "myValue = ")
gives Runtime error 3075: Syntax error (missing operator) in 'myValue = '
Here is a guide on how to debug problems like this.
Take the code apart (one command per line), and use intermediate variables. Their values can be seen in break mode by hovering the mouse on the variable name, or in the Watch window.
Recommended reading: Debugging VBA Code
If you use DLookup, there is no need at all for a recordset, so I have removed it.
Run (or step through) this code, and the error will become clear:
Private Sub Form_Current()
Dim SiteID As Long
Dim HotelID As Long
Dim strCaption As String
SiteID = Nz(Me.Site_ID.Value, 0)
If SiteID > 0 Then
' Intentionally without Nz(), will throw error
HotelID = Me.txtHotelID
' Nz() will be needed here too!
strCaption = DLookup("H2OBillingIDNum", "Sites", "H2OBillingIDNum = " & HotelID)
Else
strCaption = ""
End If
Me.H2OBillingIDlbl.Caption = strCaption
End Sub
You can reduce it to:
Private Sub Form_Current()
Dim rs As DAO.Recordset
Dim SQL As String
Dim Caption As String
If Nz(Me!Site_ID.Value, 0) > 0 Then
SQL = "Select Top 1 H2OBillingIDNum From Sites Where H2OBillingIDNum = " & Nz(Me!txtHotelID.Value, 0) & ""
Set rs = CurrentDb.OpenRecordset("SQL", dbOpenDynaset, dbSeeChanges)
Caption = rs!Fields(0).Value
End If
Me!H2OBillingIDlbl.Caption = Caption
Set rs = Nothing
End Sub
As you can see, it doesn't make much sense, as you look up H2OBillingIDNum which you already have as Me!txtHotelID.Value, so it probably should read:
SQL = "Select Top 1 SomeTextField From Sites Where H2OBillingIDNum = ...
Sorry misunderstod you
I don't really see the purpose, but one thing is sure - if your Dlookup returns a Null you get ant error. You cannot load the caption with null.
An NZ around the Dlookup is needed. But i don't know if it is possible that the Dlookup doesn't find anything
I'm developing a call log system, and for tracking purposes the manager wants each user to be logged in upon entry.
I have a module that displays the current logged on user with the code below. I would like for the system to search the table "TBL_Users" for the username and in the text boxes display all the information pertinent to that username. Should that user not be in the database i need to display an error and not allow the user to progress into the system. I'm aware i may need to use a Dlookup but I'm unsure how to code this.
Option Compare Database
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Function fOSUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If (lngX > 0) Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = vbNullString
End If
End Function
After playing around with Dlookup for a while, I need the text-boxes to populate on form load. This is the Dlookup i used.
Private Sub Form_Load()
Windows_Logontxt = fOSUserName()
'agentname = DLookup("Agent_Name", "TBL_Users", "Windows_Logon=" & Windows_Logontxt)
End Sub
It seems Windows_Logon and Windows_Logontxt are text values, so enclose Windows_Logontxt in quotes when you create the string for the third argument to DLookup.
DLookup("Agent_Name", "TBL_Users", "Windows_Logon='" & Windows_Logontxt & "'")
Code to create new form instance of a closed form using form name
I want to replace the long Select Case list with a variable.
Full code of module
In Access 2010 I have a VBA function that opens a new instance of a form when given a string containing the form's name. By adding a form variable "frm" to a collection:
mcolFormInstances.Add Item:=frm, Key:=CStr(frm.Hwnd)
The only way I can figure out to open "frm" is with a Select Case statement that I've manually entered.
Select Case strFormName
Case "frmCustomer"
Set frm = New Form_frmCustomer
Case "frmProduct"
Set frm = New Form_frmProduct
... etc ... !
End Select
I want it to do it automatically, somewhat like this (although this doesn't work):
Set frm = New Eval("Form_" & strFormName)
Or through some code:
For Each obj In CurrentProject.AllForms 'or AllModules, neither work
If obj.Name = strFormName Then
Set FormObject = obj.AccessClassObject 'or something
End If
Next
Set frm = New FormObject
I just want to avoid listing out every single form in my project and having to keep the list updated as new forms are added.
I've also done some testing of my own and some reading online about this. As near as I can tell, it isn't possible to create a new form object and set it to an instance of an existing form using a string that represents the name of that form without using DoCmd.OpenForm.
In other words, unless someone else can prove me wrong, what you are trying to do cannot be done.
I think you are looking for something like this MS-Access 2010 function. (The GetForm sub is just for testing):
Function SelectForm(ByVal FormName As String, ByRef FormExists As Boolean) As Form
For Each f In Application.Forms
If f.Name = FormName Then
Set SelectForm = f
FormExists = True
Exit Function
End If
Next
FormExists = False
End Function
Sub GetForm(ByVal FormName As String)
Dim f As New Form
Dim FormExists As Boolean
Set f = SelectForm(FormName, FormExists)
If FormExists Then
MsgBox ("Form Found: " & f.Caption)
Else
MsgBox ("Form '" & FormName & "' not found.")
End If
End Sub
Here's an ugly hack I found:
DoCmd.SelectObject <acObjectType>, <YourObjectsName>, True
DoCmd.RunCommand acCmdNewObjectForm
The RunCommand step doesn't give you programmatic control of the object, you'll have to Dim a Form variable and Set using Forms.Item(). I usually close the form after DoCmd.RunCommand, then DoCmd.Rename with something useful (my users don't like Form1, Form2, etc.).
Hope that helps.
I'm trying to call an event when the user returns focus to the Access application when a specific form is open. The following event doesn't seem to fire up at all.
Private Sub Form_GotFocus()
Call crtListDirectory
End Sub
Does any body have any ideas as to how I could trigger this event to happen, and when/how does the Form_GotFocus event actually get triggered.
thanks in advance for any help
Noel
Access help:
A form can get the focus only if all
visible controls on a form are
disabled, or there are no controls on
the form.
You might like to try Activate.
EDIT re Comments
The only way I can see of doing what you seem to want is with APIs, which is somewhat messy. To demonstrate this you will need a form with two controls Text0 and Text2 (these are the default names). Set the Timer Interval to something suitable, say 2000, and the Timer Event to:
Private Sub Form_Timer()
Dim lngWin As Long
Dim s As String
'This is just a counter to show that the code is running
Me.Text2 = Nz(Me.Text2, 0) + 1
'API
lngWin = GetActiveWindow()
s = GetWinName(lngWin)
If s = "Microsoft Access" Then
If Me.Text0 = "Lost Focus" Then
Me.Text0 = "Focus returned"
End If
Else
Me.Text0 = "Lost Focus"
End If
End Sub
You will now need a module for:
Option Compare Database
Declare Function GetActiveWindow Lib "user32" () As Integer
Declare Function GetWindowText Lib "user32.dll" Alias _
"GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As _
String, ByVal cch As Long) As Long
Declare Function GetWindowTextLength Lib "user32" Alias _
"GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Function GetWinName(hw As Long)
Dim lngText As Long ' receives length of text of title bar
Dim strWinName As String ' receives the text of the title bar
Dim lngWinText As Long ' receives the length of the returned string
lngText = GetWindowTextLength(hw)
strWinName = Space(lngText + 1)
lngWinText = GetWindowText(hw, strWinName, lngText + 1)
strWinName = Left(strWinName, lngWinText)
GetWinName = strWinName
End Function
This is all very, very rough, but it gives you something to mess about with.
How do I do a search and replace of text within a module in Access from another module in access? I could not find this on Google.
FYI, I figured out how to delete a module programatically:
Call DoCmd.DeleteObject(acModule, modBase64)
I assume you mean how to do this programatically (otherwise it's just ctrl-h). Unless this is being done in the context of a VBE Add-In, it is rarely (if ever) a good idea. Self modifying code is often flagged by AV software an although access will let you do it, it's not really robust enough to handle it, and can lead to corruption problems etc. In addition, if you go with self modifying code you are preventing yourself from ever being able to use an MDE or even a project password. In other words, you will never be able to protect your code. It might be better if you let us know what problem you are trying to solve with self modifying code and see if a more reliable solution could be found.
After a lot of searching I found this code:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Function to Search for a String in a Code Module. It will return True if it is found and
'False if it is not. It has an optional parameter (NewString) that will allow you to
'replace the found text with the NewString. If NewString is not included in the call
'to the function, the function will only find the string not replace it.
'
'Created by Joe Kendall 02/07/2003
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function SearchOrReplace(ByVal ModuleName As String, ByVal StringToFind As String, _
Optional ByVal NewString, Optional ByVal FindWholeWord = False, _
Optional ByVal MatchCase = False, Optional ByVal PatternSearch = False) As Boolean
Dim mdl As Module
Dim lSLine As Long
Dim lELine As Long
Dim lSCol As Long
Dim lECol As Long
Dim sLine As String
Dim lLineLen As Long
Dim lBefore As Long
Dim lAfter As Long
Dim sLeft As String
Dim sRight As String
Dim sNewLine As String
Set mdl = Modules(ModuleName)
If mdl.Find(StringToFind, lSLine, lSCol, lELine, lECol, FindWholeWord, _
MatchCase, PatternSearch) = True Then
If IsMissing(NewString) = False Then
' Store text of line containing string.
sLine = mdl.Lines(lSLine, Abs(lELine - lSLine) + 1)
' Determine length of line.
lLineLen = Len(sLine)
' Determine number of characters preceding search text.
lBefore = lSCol - 1
' Determine number of characters following search text.
lAfter = lLineLen - CInt(lECol - 1)
' Store characters to left of search text.
sLeft = Left$(sLine, lBefore)
' Store characters to right of search text.
sRight = Right$(sLine, lAfter)
' Construct string with replacement text.
sNewLine = sLeft & NewString & sRight
' Replace original line.
mdl.ReplaceLine lSLine, sNewLine
End If
SearchOrReplace = True
Else
SearchOrReplace = False
End If
Set mdl = Nothing
End Function
Check out the VBA object browser for the Access library. Under the Module object you can search the Module text as well as make replacements. Here is an simple example:
In Module1
Sub MyFirstSub()
MsgBox "This is a test"
End Sub
In Module2
Sub ChangeTextSub()
Dim i As Integer
With Application.Modules("Module1")
For i = 1 To .CountOfLines
If InStr(.Lines(i, 1), "This is a Test") > 0 Then
.ReplaceLine i, "Msgbox ""It worked!"""
End If
Next i
End With
End Sub
After running ChangeTextSub, MyFirstSub should read
Sub MyFirstSub()
MsgBox "It worked!"
End Sub
It's a pretty simple search but hopefully that can get you going.
additional for the function (looping through all the lines)
Public Function ReplaceWithLine(modulename As String, StringToFind As String, NewString As String)
Dim mdl As Module
Set mdl = Modules(modulename)
For x = 0 To mdl.CountOfLines
Call SearchOrReplace(modulename, StringToFind, NewString)
Next x
Set mdl = Nothing
End Function
Enjoy ^^