There is a code:
Private Sub Button0_Click()
Dim nameField As String
nameField = "Field0"
Dim nameForm As String
nameForm = "Form1"
' DoCmd.OpenForm "Form1"
DoCmd.OpenForm nameForm
Forms.Text = "Message for `Form1`"
End Sub
In this code, you can access the form field through the variable "nameField".
Line
Forms.Text = "Message for `Form1`"
Question.
How to write the path to the form through a variable?
Those. replace Forms! [Form1] with a variable.
For example, something like:
Dim nameForm As String
nameForm = "Form1"
Forms.Text = "Message for `Form1`"
Or something like:
Dim nameForm As String
nameForm = "Form1"
Forms(nameForm)(nameField).Text = "Message for `Form1`"
Or determine the active form and use it:
Dim FormActiv As Form
Set FormActiv = Screen.ActiveForm
nameForm.Name = FormActiv.Name
Forms.Text = "Message for `Form1`"
How to do it right?
Essence: I registered in one place the name of the form and use it in various procedures or in several places of the procedure.
It is:
Forms(nameForm)(nameField).Value = "Message for 'Form1'"
Related
Basically It's a login form and i'm trying to save the ID which is the Me.CBOUsername.Column(0) but I get an error when i try to call it in another form.
Option Compare Database
Option Explicit
Public ID_ As String
Private Sub Command4_Click()
Dim strCBOPass As String
Dim strPassword As String
strCBOPass = Me.CBOUsername.Column(1)
strPassword = Me.txtpassword
If strCBOPass = strPassword Then
MsgBox "Login Successful!"
DoCmd.OpenForm "Form1"
DoCmd.Close acForm, Me.Name
ID_ = Me.CBOUsername.Column(0)
Else
MsgBox "login Unsuccessful!"
End If
End Sub
It may be a little easier to explain this way.
As an example of a global variable:
Public Global_Variable1 as String
Public Sub Procedure1()
Global_Variable1 = "Test"
End Sub
Public Sub Procedure2()
Call Procedure1
MsgBox (Global_Variable1) 'return Test
End Sub
Add the module by right-clicking, and using Insert > Module
I am building a library database and i have a working script to probe a web database using the ISBN number and return data about the book. I have successfully made the data print to the immediate window using debug.print and then the specific property of the object. I am now wanting to print the data retrieved straight in to the database.
here is my code for the ISBN search:
Option Compare Database
Dim BookTitle As String
Dim BookTitleLong As String
Dim BookAuthorsText As String
Dim BookPublisherText As String
Dim BookSummary As String
Dim BookNotes As String
Dim accessKey As String
Private Sub Class_Initialize()
'Your isbnDB access key'
accessKey = "xxxxxx" 'Working access key here
End Sub
Property Get Title() As String
Title = BookTitle
End Property
Property Get TitleLong() As String
TitleLong = BookTitleLong
End Property
Property Get AuthorsText() As String
AuthorsText = BookAuthorsText
End Property
Property Get PublisherText() As String
PublisherText = BookPublisherText
End Property
Property Get Summary() As String
Summary = BookSummary
End Property
Property Get Notes() As String
Notes = BookNotes
End Property
Public Function Lookup(ISBN As String) As Boolean
Lookup = False
Dim xmlhttp
Set xmlhttp = CreateObject("MSXML2.xmlhttp")
xmlhttp.Open "GET", "https://isbndb.com/api/books.xml?access_key=" & accessKey & "&results=texts&index1=isbn&value1=" & ISBN, False
xmlhttp.send
'Debug.Print "Response: " & xmlhttp.responseXML.XML'
Dim xmldoc
Set xmldoc = CreateObject("Microsoft.XMLDOM")
xmldoc.async = False
'Note: the ResponseXml property parses the server's response, responsetext doesn't
xmldoc.loadXML (xmlhttp.responseXML.XML)
If (xmldoc.selectSingleNode("//BookList").getAttribute("total_results") = 0) Then
MsgBox "Invalid ISBN or not in database"
Exit Function
End If
If (xmldoc.selectSingleNode("//BookList").getAttribute("total_results") > 1) Then
MsgBox "Caution, got more than one result!"
Exit Function
End If
BookTitle = xmldoc.selectSingleNode("//BookData/Title").Text
BookTitleLong = xmldoc.selectSingleNode("//BookData/TitleLong").Text
BookAuthorsText = xmldoc.selectSingleNode("//BookData/AuthorsText").Text
BookPublisherText = xmldoc.selectSingleNode("//BookData/PublisherText").Text
BookNotes = xmldoc.selectSingleNode("//BookData/Notes").Text
BookSummary = xmldoc.selectSingleNode("//BookData/Summary").Text
Lookup = True
End Function
and here is the code i have used to print to the immediate window
Public Function t()
Dim book
Set book = New ISBN
book.Lookup ("0007102968")
Debug.Print book.Title
Debug.Print book.PublisherText
Debug.Print book.AuthorsText
Debug.Print book.TitleLong
Debug.Print book.Summary
Debug.Print book.Notes
End Function
this is all based off this question asked a few years back:
ISBN -> bookdata Lookup to fill in a database
i would also like to be able to input the ISBN through a form if anyone can help with that :)
You can try the following approach.
First of all, create a user-defined data type to store the book data:
Public Type Book
ISBN As String
Title As String
TitleLong As String
AuthorsText As String
PublisherText As String
Summary As String
Notes As String
End Type
Then create an insert query and pass the book values as parameters. Let's name the query qryAdd.
PARAMETERS prmISBN Text (255),
prmTitle Text (255),
prmPublisherText Text (255),
prmAuthorsText Text (255),
prmTitleLong Text (255),
prmSummary LongText,
prmNotes LongText;
INSERT INTO T ( ISBN, Title, PublisherText, AuthorsText, TitleLong, Summary, Notes )
SELECT prmISBN AS ISBN,
prmTitle AS Title,
prmPublisherText AS PublisherText,
prmAuthorsText AS AuthorsText,
prmTitleLong AS TitleLong,
prmSummary AS Summary,
prmNotes AS Notes;
'Change T to the name of your table and update the field names.
Lastly, the function to call the insert query where we pass the book to be inserted.
Public Function InsertToDatabase(b As Book) As Boolean
With CurrentDb().QueryDefs("qryAdd")
.Parameters("[prmISBN]").Value = b.ISBN
.Parameters("[prmTitle]").Value = b.Title
.Parameters("[prmTitleLong]").Value = b.TitleLong
.Parameters("[prmPublisherText]").Value = b.PublisherText
.Parameters("[prmAuthorsText]").Value = b.AuthorsText
.Parameters("[prmSummary]").Value = b.Summary
.Parameters("[prmNotes]").Value = b.Notes
.Execute dbFailOnError
End With
'all good
InsertToDatabase = True
End Function
To test it:
Sub Test()
Dim b As Book
b.ISBN = "aaa"
b.Title = "bbb"
b.TitleLong = "ccc"
b.PublisherText = "ddd"
b.AuthorsText = "eee"
b.Summary = "fff"
b.Notes = "ggg"
If InsertToDatabase(b) Then MsgBox "Done!"
End Sub
I have checked Google, and the suggested answers here, but have had no luck unfortunately.
The last thing I need to do is have an email read the rateNbr variable into the email body, but it just comes up empty.
I tried to make Public Function FuncRateCheckFile read as Public Function FuncRateCheckFile(ByVal rateNbr As String), to try and enable it to be called outside the function, but this then breaks the function when it is called elsewhere. :(
Here is the code, with comments as to where I am referring:
Public Function FuncRateCheckFile()
Dim blnContinue As Boolean
Dim strLine As String
Dim strSearchFor, strSearchWrd, LineCount, objFSO, objTextFile, arrLines
Dim dteNow As Date
Dim newDate As String
'//==============================================================================================
'// DECLARED
Dim rateNbr As String
'//==============================================================================================
FuncRateCheckFile = False
blnContinue = True
If blnContinue Then
Const ForReading = 1
'Get todays date and reformat it
dteNow = DateValue(Now)
newDate = Format(dteNow, "dd/MM/yy")
strSearchWrd = newDate
'Read the whole file
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile(m_RateCheckFile, ForReading)
LineCount = 0
Do Until objTextFile.AtEndOfStream
strLine = objTextFile.ReadLine()
If InStr(strLine, strSearchWrd) <> 0 Then
arrLines = Split(strLine, vbCrLf)
LineCount = LineCount + 1
End If
Loop
'Log a message to state how many lines have todays day, and if there are none, log an error
If LineCount <> 0 Then
'//==============================================================================================
'// "rateNbr" IS WHAT I AM TRYING TO GET TO PUT IN THE EMAIL
LogMessage "Rate file date is correct"
rateNbr = "Number of rates for " & newDate & " in the file recieved on " & newDate & " is " & LineCount
LogMessage rateNbr
EmailAdvice2
objTextFile.Close
'//==============================================================================================
Else
blnContinue = False
LogError "Failed to retrieve Current Rate date, please check rate file.."
EmailAdvice
objTextFile.Close
End If
End If
FuncRateCheckFile = blnContinue
LogMessage "Completed Check Rate file"
End Function
Private Function EmailAdvice2()
Dim strSMTPFrom As String
Dim strSMTPTo As String
Dim strSMTPRelay As String
Dim strTextBody As String
Dim strSubject As String
Dim oMessage As Object
'//==============================================================================================
'// DECLARED AGAIN
Dim rateNbr As String
'//==============================================================================================
Set oMessage = CreateObject("CDO.Message")
strSMTPFrom = "no-reply#work.com.au"
strSMTPTo = "me#work.com.au"
strSMTPRelay = "smtp.relay.com"
'//==============================================================================================
'// THIS MAKES THE TEXT BODY BLANK, BUT THE EMAIL STILL SENDS
strTextBody = rateNbr
'//==============================================================================================
strSubject = "Todays rates"
'strAttachment = "full UNC path of file"
oMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
oMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPRelay
oMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
oMessage.Configuration.Fields.Update
oMessage.Subject = strSubject
oMessage.From = strSMTPFrom
oMessage.To = strSMTPTo
oMessage.textbody = strTextBody
'oMessage.AddAttachment strAttachment
oMessage.Send
End Function
I am positive that it is blank because I have declared rateNbr under EmailAdvice2() and then not given it anything to fill the variable with. But I don't know how to make it call the variable under FuncRateCheckFile().
Thanks to all for any assistance.
As Plutonix stated, this is a scope issue.
Move the declaration of your 'rateNbr' variable out to class level, and remove the local declarations inside your functions:
Dim rateNbr As String ' <-- out at class level it will be accessible from both functions
Public Function FuncRateCheckFile()
...
' REMOVE both the decalarations of "rateNbr" that are INSIDE your functions
...
End Function
Private Function EmailAdvice2()
...
' REMOVE both the decalarations of "rateNbr" that are INSIDE your functions
...
End Function
I have one method
Public CurrentFileNameNoExtension As String
Public Sub importexcelfile()
CurrentFileNameNoExtension ="Filename"
'do something
End Sub
I want to use CurrentFileNameNoExtension value in onEnter event of the dropdown list(cmvalues) event. That Value use in sql query. My code is
Private Sub cmvalues_Enter()
Dim qstng As String
qstng = CurrentFileNameNoExtension
Me.cmvalues.RowSourceType = "Table/Query"
Me.cmvalues.RowSource = "Select F1 from " & qstng & " WHERE F1 <> 'Control Model';"
End Sub
But qstng value is empty. it is not giving the value in the importexcelfile() function.
EDIT: As I've just noticed, thanks to #simoco, that this is indeed for a userform, there are actually a couple of things to pull this off. One is using globals, which is quite tricky, and another is to use a function to get the string you want.
Function CurrentFileNameNoExtension() As String
'Do some FSO or GetOpenFileName here.
CurrentFileNameNoExtension = "Filename"
End Sub
Private Sub cmvalues_Enter()
qstng = CurrentFileNameNoExtension
Me.cmvalues.RowSourceType = "Table/Query"
Me.cmvalues.RowSource = "Select F1 from " & strFileName & " WHERE F1 <> 'Control Model';"
End Sub
There is not much of an issue using the code you have, really. You just have to make sure that the first sub is called before the second one so that cmvalues_Enter has a valid string to process.
Place this function under Microsoft Access Class Objects Form control,Where cmvalues dropdown exists
Public CurrentFileNameNoExtension As String
Public Sub importexcelfile()
CurrentFileNameNoExtension ="Filename"
'do something
End Sub
I need some code that when a check box is unchecked it will change the background color of my form and return it back to its original color when checked. The code i have for the check box currently locks a combo box when a value is chosen. Example below
Private Sub AccessKeyNo_AfterUpdate()
If MsgBox("Do you want to assign Access Key " & Me.AccessKeyNo & "?", _
vbYesNo) = vbYes Then
Me.GuestAccessKeyID = Me.AccessKeyNo
If Me.Dirty Then Me.Dirty = False
Me.AccessKeyNo.Requery
Me.AccessKeyNo = Null
Me.MyCheckBox = IsNull(Me.GuestAccessKeyID)
End If
End Sub
In a standard module (not the form module -- the scope of the constants would be limited to form, thus you wouldn't be able to reuse them):
Public Const colorBlue_Cornflower = "15714765"
Public Const colorTan_Encarnacion = "11398133"
Now in the module for the form:
Dim colorThis as String, booWhatever as Boolean
booWhatever = Me.MyCheckBox ''Use of the variable can prevent problems
If booWhatever Then
colorThis = colorBlue_Cornflower
Else
colorThis = colorTan_Encarnacion
End If
subFrm.Form.Section(acDetail).BackColor = colorThis
subFrm.Form.Section(acHeader).BackColor = colorThis
subFrm.Form.Repaint