Technical ramblings | Mark Brooks
Good article on Early and Late Binding
Coding can appear very complicated sometimes but to simplify the difference in terms of implementation this line is very clear;
The only difference between early binding and late binding (in terms of the code you write) is in the variable declaration.
Or it could be an excuse to post a really nice picture of some bindings.
The following uses a function and the before update event of a form.
Sometimes it can be useful to have some kind of order field in the child records to indicate the order or version numbers of items. Although an incrementing Primary Key can be used child records may be in the thousands and if related to the parent you may want a simple almost ranking within the group. Which may be more meaningful when viewed filtered according to the parent.
A particular case may be where you are storing documents which have some kind of version.
Public Function GetChildCount(OrderNo as Integer) As Integer
Dim intCount as Integer
intCount = DCount("FKID","[ParentTable]","[FKID]=" & OrderNo)
GetChildCount = IntCount + 1
End Function
This counts the number of records with the same FKID in the table called ParentTable with a FKID equal to OrderNo
Then within the before update event of the Sub_Form
Private Sub Form_BeforeUpdate(Cancel As Integer) If Me.NewRecord Then Me.Order = GetChildCount([SiteID]) End If End Sub
The If statement just ensures that when you edit a record the order is not updated to the count of the child records if a count already exists in the field Order.
Boolean Switch to test for specific character sets within a field. This codes tests whether a field contains blanks or the specified characters only and will return -1 if true and 0 if false. If a character occurs that is not within the LValid_Values it will return 0 as false. This is different from identifying whether a field contains the listed characters. This can be useful for identifying characters in a field that you are wanting to alter the variable type. MS Access (and other databases) will delete field values that cannot be converted so if possible you want to identify values with illegal characters. This code can be used to identify this. Change the value of LValid_Values to represent the allowable characters and then you can reference the function in a query to identify illegal records and values. My primary use case is testing for numerical values in a string field which I am looking to alter so that I can change it into a long integer variable type. This is particularly useful for hunting down things like letters in house numbers or slashes in flat identities.
Function CharCheck(targetField) As Boolean
Dim LPos As Integer
Dim LChar As String
Dim LValid_Values As String
'Start at first character in strField
LPos = 1
LValid_Values = ".0123456789"
'Test each character in strField
While LPos <= Len(targetField)
'Single character in strField
LChar = Mid(targetField, LPos, 1)
'If character is not LValid Value, return FALSE
If InStr(LValid_Values, LChar) = 0 Then
CharCheck = False
Exit Function
End If
'Increment counter
LPos = LPos + 1
Wend
'Value is LValid Value, return TRUE
CharCheck = True
End Function
Imagine you have a school full of Students and they have done a variety of exams. All results are collected in a table and you would like to obtain rankings by subject. How can you automatically rank all the students for whom you have results.
The table T01Student
PKID Students Marks Subject
1 Tony 34 Maths
2 Bob 32 Maths
3 Thor 48 Maths
4 Jack 42 Geography
5 Tom 41 Geography
6 Kate 45 Geography
7 Sid 26 Geography
8 Michael 40 Chemistry
9 Colin 50 Chemistry
10 Hannah 60 Chemistry
11 Geoff 5 Chemistry
12 Jim 2 Chemistry
It is then possible to use the following query to get a ranking
SELECT (select count(*) from T01Student as tbl2 where T01Student.marks < tbl2.marks and T01Student.subject = tbl2.subject)+1 AS rank, * INTO TempRank FROM T01Student;
rank PKID Students Marks Subject
2 1 Tony 34 Maths
3 2 Bob 32 Maths
1 3 Thor 48 Maths
2 4 Jack 42 Geography
3 5 Tom 41 Geography
1 6 Kate 45 Geography
4 7 Sid 26 Geography
3 8 Michael 40 Chemistry
2 9 Colin 50 Chemistry
1 10 Hannah 60 Chemistry
4 11 Geoff 5 Chemistry
5 12 Jim 2 Chemistry
Then use a simple select query to order by subject then rank – Note Depending if you want to count down from the top so the lowest “Marks” gets the highest rank reverse the < symbol or reverse the order of rank - here I have highest mark is no 1. Subject rank Students Marks Chemistry 1 Hannah 60 Chemistry 2 Colin 50 Chemistry 3 Michael 40 Chemistry 4 Geoff 5 Chemistry 5 Jim 2 Geography 1 Kate 45 Geography 2 Jack 42 Geography 3 Tom 41 Geography 4 Sid 26 Maths 1 Thor 48 Maths 2 Tony 34 Maths 3 Bob 32 If for some reason you are wanting to store the rank so that you can artificially alter the ranking then it would be possible to use make table to create a new table with the ranking and then update a position field with the rank in the ranking query based on the PKID
Many datasets can be somewhet confused by the time you get them. Maybe you had no control of the export from the database or maybe you asked for the right information and it came back somewhat warped.
SQL has powerful fuctions that can pretty much clean things up however you would like.
We can use multiple SQL commands within an MS Access module to clean up a source by placing them consecutively within a module here is the structure of some of the queries that I use.
UPDATE SELECTED FIELDS BASED ON A MATCHED STRING IN ANOTHER FIELD
SQL that updates Town and PostalTown fields based on a string in an aggregated PostalAdd field.
Please note that _ sign denotes a movement to another line within the VB Module required to make the SQL String run correctly. This may require alteration if you are cutting and pasting from this page.
Dim SQL As String SQL = "UPDATE Table01 SET Table01.Town = 'Barassie', Table01.PostalTown = 'TROON' " & _ "WHERE (((Table01.PostalAdd) Like '*Barassie, TROON*'));" DoCmd.RunSQL SQL
CONVERT A STRING FIELD TO ALL CAPITALS, ALL CAMEL CASE OR ALL LOWER CASE
The following SQL converts the street field of Table01 to all capitals. This could be run like the previous SQL from within an MS Access module
Dim SQL1 As String SQL1 = "UPDATE Table01 SET Table01.Street = StrConv([Table01].[Street],1);" DoCmd.RunSQL SQL1
In the above code change the trailing number parameter to select type of alteration
1 – ALL CAPIALS
2 – all lower case
3 – Camel Case
PARSE OUT LEFT PART OF STRING BY LOCATING UNIQUE CHARACTER OR STRING
This looks to the Yourfieldname field of TableRainbow and searches from the left for a comma and returns everything to the left into a field called LeftParse
Dim SQL2 As String SQL2 = "SELECT Left$([Yourfieldname],InStr(1,[Yourfieldname],",")-1) AS LeftParse FROM TableRainbow;" DoCmd.RunSQL SQL2
PARSE OUT RIGHT PART OF STRING BY LOCATING UNIQUE CHARACTER OR STRING
If you have a string with commas this string will count the length of the string then count the number of characters to your unique string – in this case a comma – and then return all characters from that string to the right of that comma.
The below code looks to the Yourfieldname of TableRainbow counts its length and then find the first comma from the right and returns the information as a select query result in a field named Right Parse. It should be noted that it searches through the target field searching from the left. IF there are multiple commas then it will stop counting when it hits the first comma. You can substitute the right part of the function with a number.
Dim SQL3 As String SQL3 = "SELECT Right$([Yourfieldname],Len([Yourfieldname])-InStr(1,[Yourfieldname],",")-1) AS RightParse FROM TableRainbow;" DoCmd.RunSQL SQL3
A while back I wrote a post about how allowing parameters to be passed to URLs is a big benefit in increasing the speed with which you can navigate to individual records in apparently non-connected web applications.
But what do you do if you are faced with a satellite application whose vendor has not implemented this URL friendly facility. Users are left with the very jarring break to the flow of their work when they have to leave the application they are in and navigate to another application sometimes manually having to link to the other application records form via a search field. This searching task when multiplied many times can be really tedious, repetitive, demotivating and time consuming not to mention pointless.
How can we better serve our users?
The other day I came across an open source program called AutoHotKey that allows me to improve this task.
Autohotkey is an open source project that allows the creation and compilation of simple or complicated scripts that can be used to navigate anything on a computer. That means desktop OR web applications. The following is something that I worked out last week to be able to navigate a web application by triggering a script from MS Access vba. The great thing is that you can pass parameters from a database application to a middle layer and trigger a set of commands to be run.
Let us take the example of a recent problem I faced. Many councils throughout the United Kingdom have bought an application from a company that manages the information associated with making planning applications, it consists of both desktop and web applications that help manage the submission and decision making associated with development. The vendor recently “upgraded” the application resulting in it no longer accepting planning application numbers to its URL as a method of going straight to the record. This was meaning that users of one of my satellite applications were faced with being dropped into a search screen and then needing to manually type a field from one application into the field of another application. QED dull and repetitive task.
There follows and overview of my solution. Firstly download the following programs
1)AutoHotKey
2)iWB2 Learner – which is a small program for identifying element names and id in INTERNET explorer.
iWB2 Learner
iwebbrowser2 Download
My script for Autohotkey was as follows.
FindRecordReference.ahk (written in plain old notepad and saved to a known location with the suffix changed to ahk)
=====================
APPLICATION = %1%
URL := "https://onlinerecordset/"
WB := ComObjCreate("InternetExplorer.Application")
WB.Visible := True
WB.Navigate(URL)
While wb.readyState != 4 || wb.document.readyState != "complete" || wb.busy ; wait for page to open
Sleep, 10
wb.document.getElementById("simpleSearchString").value := Application
wb.document.getElementsByTagName("INPUT")[4].Click()
While wb.readyState != 4 || wb.document.readyState != "complete" || wb.busy
Sleep, 10
return
===================
Using iWB2 Learner to identify the element names on the web page
This video shows iWB2 Learner being used it unfortunately does not have any sound.
VIDEO Using iWB Learner with AutoHotKey
—-
Next you will need to trigger the AHK – You will need design access to the program that is sending the instruction to do this. In my MS Access application I have the following code that triggers the script in the above.
Private Sub Command43GoToOnlineRecord_Click()
Dim strRecordNo As String
Dim strAHKname As String
strPlanApp = "LIVE/" & Me.RecordNo
strAHKname = "\\[YourServerName]\FindRecordReference.exe"
Call Shell(strAHKname & " " & strRecordNo, vbMaximizedFocus)
End Sub
Notes:
The computer that holds the AHK script need not have AutoHotKey installed if it doesn’t you can compile your script into an executable that will not require installation. Here I created the executable on another computer and transferred it to the \\server1-cluster\ahk location ready to be called by the VBA
Consecutive parameters passed to Autohokey are consecutively named %1% %2% etc.. In my script I pass the planning application as %1% and rename it APPLICATION immediately.
Compiling the AHK is done by moving to a computer with AHK installed and navigating in Explorer to the file and then right click and Compile will be an option. Note the processor architecture is important when compiling. If your target machine is 32bit then you need to compile on a 32bit machine – same with 64.
In situations where a Parent record has a limited number of children (0 to 10 works well) and you would like to list those children next to the parent somewhat like you would with a Pivoted table. Pivoting the table would however result in a massive table which is extremely wide. Pivoting and concatenating the fields can keep the resulting list within a manageable width. Take for example the following table.
So we have table with four header records and the children all relate to those parents. For each parent obtain a list of children
Firstly place the following function in a module
Public Function Conc(Fieldx, Identity, Value, Source) As Variant
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim SQL As String
Dim vFld As Variant
Set cnn = CurrentProject.Connection
Set rs = New ADODB.Recordset
vFld = Null
SQL = "SELECT [" & Fieldx & "] as Fld" & _
" FROM [" & Source & "]" & _
" WHERE [" & Identity & "]=" & Value
' open recordset.
rs.Open SQL, cnn, adOpenForwardOnly, adLockReadOnly
' concatenate the field.
Do While Not rs.EOF
If Not IsNull(rs!Fld) Then
vFld = vFld & ", " & rs!Fld
End If
rs.MoveNext
Loop
' remove leading comma and space.
vFld = Mid(vFld, 3)
Set cnn = Nothing
Set rs = Nothing
' return concatenated string.
Conc = vFld
End Function
Now set up a Query and call the function in an expression
This results in the appropriate list
If users are editing or creating a record and there is an option on the form to print out the form if they press it they will expect the information that they have just created to appear on the print preview. Normally MS Access does not save the information to the database until the record is exited or specifically instructed. This can lead to user confusion when they enter a record hit print preview expecting to see the record and see a blank preview.
Placing the following code before calling the print preview will ensure that the record is saved prior to the print preview being triggered resulting correct information being displayed in the print easy. An easy fix – you should always do the easy wins.!
Note order is important, put this before the event you are wishing to trigger (quite ubiquitous in my code)
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
Its the constant small touches that make great applications
Really simple – create a new module and create the following simple functions.
I usually name them TurnMenuOn and TurnMenuOff.
Public Function TurnMenuOn()
Application.CommandBars("Menu Bar").Enabled = True
End Function
Public Function TurnMenuOff()
Application.CommandBars("Menu Bar").Enabled = False
End Function
Then you can run at start up by creating a macro that is titled autoexec
And using the Runcode action call the TurnMenuOn() function alternatively you can call it from the form opening.
It is often useful to create a couple of straight Macros that run these functions as well so that when you are in design mode you can quickly run the functions.
With programming the devil is always in the detail. Just out of curiosity I was thinking about the code that I have posted that randomises information in a database and I was thinking why don’t I try to randomise the names using the Cyrillic alphabet?
Totally unnecessary I know but what I did discover is that Visual Basic for applications does not support Russian Cyrillics in the coding window and therefore constants cannot be statically set to Russian Cyrillic values.
As ever people have figured out how to get around this omission.
Here’s some code from the net that may help… (haven’t tried it yet)
strString = ChrW(decimal value) & ChrW(decimal value) & ChrW(decimal value) & ChrW(decimal value) & ChrW(decimal value) etc.
Search for the characters you want then hover over the symbol to see the decimal number.
It of course raises lots of questions- what alphabet do coders in Russia use as a general standard? – I’m sure other IDEs will support non western alphabets but I suspect many programming languages are Latin alphabet centric. Come to think of it that must present quite a challenge for any individuals with a language not based on the latin alphabet wanting to be programmers. Full respect I guess they first need to learn English to really get to grips with programming.
This is similar to the previous post except uses the inbuilt SendObject object to pass the string sBcc directly to Outlook. Outlook picks up the variables and so there is no need to set up public variables.
Private Sub CommandGroupEmail_Click()
On Error GoTo Err_CommandGroupEmail_Click
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
Dim MyDB As DAO.Database
Dim rsEmail As DAO.Recordset
Dim sBcc As String
Dim sSubject As String
Dim sMessageBody As String
Set MyDB = OpenDatabase("\\SERVERNAME\DIRECTORYPATH\" & "TARGET.MDB")
Set rsEmail = MyDB.OpenRecordset("SELECT ... STATEMENT", dbOpenSnapshot)
With rsEmail
.MoveFirst
Do Until rsEmail.EOF
If IsNull(![E-mail]) = False Then
sBcc = sBcc & rsEmail![E-mail] & ";"
sSubject = ""
sMessageBody = ""
End If
.MoveNext
Loop
End With
DoCmd.SendObject , , , , , sBcc , sSubject, sMessageBody, True
Set MyDB = Nothing
Set rsEmail = Nothing
Exit_CommandGroupEmail_Click:
Exit Sub
Err_CommandGroupEmail_Click:
If (Err = 2467) Or (Err = 91) Or (Err = 2483) Then
Resume Next
End If
Resume Exit_CommandGroupEmail_Click
End Sub
Below some standard code that I use to loop through a selection of records and create a string from the individual [Email] s in the below case the e-mails are passed to a form (FORMTOOPEN) – if you are using this then all text in capitals will need to be replaced by application specific information. You want to set up a global variable that is made public which you can pass the combined rsemail (in this case SendBCC) string to between opening up forms.
I tend to have a module called modGlobalVariables and I would put this in
Public SendBcc as string
Remember to be careful with your variable definitions – If you have the same variable dimensioned locally within a command and publically over the whole project values may not appear as expected when you get them.
Private Sub CommandGroupEmail_Click()
On Error GoTo Err_CommandGroupEmail_Click
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
MsgBox "Please note all available e-mails are placed in BCC section of a new form in alphabetical person name order. If a person doesn't have a listed e-mail address he/she will be omitted", , "APPLICATIONNAME"
Dim MyDB As DAO.Database
Dim rsEmail as DAO.Database
Set MyDB = OpenDatabase("\\SERVERNAME\DIRECTORYPATH\" & "TARGET.MDB")
Set rsEmail = MyDB.OpenRecordset("SELECT STATEMENT HERE"
With rsEmail
.MoveFirst
Do Until rsEmail.EOF
If IsNull(![Email]) = False Then
SendBcc = SendBcc & rsEmail![Email] & ";"
MessageSubject = ""
End If
.MoveNext
Loop
End With
stDocName = "FORMTOOPEN"
DoCmd.OpenForm stDocName, , , stLinkCriteria
Set MyDB = Nothing
Set rsEmail = Nothing
SendBcc = ""
Exit_CommandGroupEmail_Click:
Exit Sub
Err_CommandGroupEmail_Click:
If Err.Number = 2501 Then
MsgBox "The e-mail was cancelled without sending", , "APPLICATIONNAME"
Exit Sub
If Err.Number = 3734 Then
MsgBox "There are no Records Cancelling", , "APPLICATIONNAME"
Exit Sub
Else
MsgBox Err.Number
End If
End If
Resume Exit_CommandGroupEmail_Click
End Sub
Note on loading of the new form you will need to pass SendBCC into whatever text box you wish to see it in where Me.Bcc is the name of the field receiving the SendBCC string.
Private Sub Form_Load() Me.Bcc = SendBcc End Sub
Here’s a nice function I found that will completely randomize information within fields of a database. Data will not be recoverable from this process which of course is its strength.
Good if you are wanting to demonstrate a database to people that normally contains sensitive information but don’t have time to make up your own records.
Works on text fields and will randomize numbers as further numbers and letters as further letters.
Public Function ScrambleID(parmString) As String
Dim lngLoop As Long
Const cAlpha As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Const cNum As String = "0123456789"
Dim strNewChar As String
Dim strThisChar As String
For lngLoop = 1 To Len(parmString)
strThisChar = Mid$(parmString, lngLoop, 1)
Do
Select Case strThisChar
Case "A" To "Z"
strNewChar = Mid$(cAlpha, Int(Rnd * Len(cAlpha)) + 1, 1)
Case "0" To "9"
strNewChar = Mid$(cNum, Int(Rnd * Len(cNum)) + 1, 1)
End Select
Loop While strNewChar = strThisChar
ScrambleID = ScrambleID & strNewChar
Next
End Function
It seems appropriate given the name of this site and 2014 being a world cup year that I might post something on code that I found a while back now related to establishing fixtures in a league coded by, for me, a mythical character. Back then I was taking part in a squash league with some friends and we needed to figure out some way of organising the matches for everyone. Seemed simple enough everyone plays everyone else on consecutive weekends. Turns out its not quite so easy and there’s a whole branch of mathematics called combinatronics that specifically looks at the way of optimising this kind of problem. In that really humble syntax of mathematicians I heard this phrase being banded about – a non trivial problem. As ever I turned to the internet and found some code by someone called Dev Ashish. Now I don’t know about you but prior to the internet I never had access to this kinds of expert and the power of the code really blew me away. The code very neatly creates the required number of matches in a table and allows me to organise matches for individuals to play each other and from there I was able to keep scores on everyone. It was in a word a bit of genius coding.
That was approximately 2005 and come 2014 and my blog the world cup reminded me of this amazing piece of coding.
I have my suspicions of where Dev Ashish is now but I can’t tell for sure.
Keyser Söze / Woland / Dev Ashish – they’re out there…
Joking aside many thanks to Dev Ashish for posting an amazing piece of code…
Option Compare Database
Option Explicit
Public intLeagueno As Integer
Public strLeaguenme As String
Function CalculateFixtures(ByVal Age As Integer, ByVal startdate As Date, ByVal EndDate As Date) As Integer
'**************************************************
' Set Database connections and Recordsets Variables
' Coded by Dev Ashish
'**************************************************
Dim cnn As ADODB.Connection
Dim rstTeams As ADODB.Recordset
Dim rstFixtures As ADODB.Recordset
'****************************************
' Create Integer Variables
'****************************************
Dim NumberofFixtures As Integer ' Number of Fixtures between teams
Dim NumberofMatches As Integer ' Number of Matches to be played
Dim NumberofTeams As Integer ' Number of Teams
Dim Week As Integer ' Week Number for Fixtures
Dim FirstTeam As Integer
Dim LastTeam As Integer
Dim StartPosition As Integer
Dim strtdate As String
Dim intMsgbox As Integer
strtdate = InputBox("Enter the date you want the league to start", "Question?")
If (strtdate = "") Then
intMsgbox = MsgBox("Thanks anyway")
startdate = 3500
Else
startdate = strtdate
intMsgbox = MsgBox("Calculating the fixtures starting" & " " & startdate, vbOKOnly, "Result")
End If
Dim iCounter As Integer
'****************************************
' Create Player String Variables
'****************************************
Dim Player1 As String
Dim Player2 As String
'****************************************
' Create Team/GameSequence Variables based on Number of Teams
'****************************************
Dim Team(50) As String
Dim GameSequence(50) As String
Dim TeamNames(1 To 50) As String
Set cnn = CurrentProject.Connection
Set rstTeams = New ADODB.Recordset
Set rstFixtures = New ADODB.Recordset
'*********************************************************
'Open the Tables Teams and Fixtures
'*********************************************************
rstTeams.Open "SELECT * FROM tblTeams Where leagueno = " & intLeagueno & "", cnn, adOpenKeyset, adLockOptimistic
'Where AgeGroup = 'u" & Age & "'"
rstFixtures.Open "tblFixtures", cnn, adOpenKeyset, adLockOptimistic
'****************************************************
' Read the Team Names into an Array
'****************************************************
iCounter = 1
Do While Not rstTeams.EOF
TeamNames(iCounter) = rstTeams.Fields("Team")
iCounter = iCounter + 1
rstTeams.MoveNext
Loop
'*****************************
'Set Main constants
'*****************************
NumberofTeams = iCounter - 1
NumberofFixtures = NumberofTeams - 1
NumberofMatches = NumberofTeams / 2
'*****************************************************
' Clear the Game Sequence Array
'*****************************************************
For iCounter = 1 To NumberofFixtures
GameSequence(iCounter) = ""
Next iCounter
'*****************************************************
' Clear the Teams Array
'*****************************************************
For iCounter = 1 To NumberofTeams
Team(iCounter) = iCounter
Next iCounter
FirstTeam = 0
'*****************************************************
' Create the Game Sequence ready for the fixtures
'*****************************************************
For Week = 1 To NumberofFixtures
FirstTeam = FirstTeam + 1
For iCounter = FirstTeam To FirstTeam + NumberofFixtures - 1
If iCounter > (NumberofFixtures) Then
LastTeam = iCounter - NumberofFixtures
Else
LastTeam = iCounter
End If
GameSequence(Week) = GameSequence(Week) & " " & Format(Team(LastTeam), "00")
Next iCounter
GameSequence(Week) = Trim(GameSequence(Week)) + " " & Format(Team(NumberofTeams), "00")
Next Week
'***************************************************
'Insert the new fixtures into the Table
'***************************************************
For Week = 1 To NumberofFixtures
StartPosition = 1
'Debug.Print "Week " & Week
For iCounter = 1 To NumberofMatches
Player1 = Mid(GameSequence(Week), StartPosition, 2)
Player2 = Left(Right(GameSequence(Week), (StartPosition) + 1), 2)
StartPosition = StartPosition + 3
rstFixtures.AddNew
rstFixtures.Fields("WeekNo") = Week
'rstFixtures.Fields("HomeTeam") = TeamNames(HomeTeam)
rstFixtures.Fields("Player1") = TeamNames(Player1)
'rstFixtures.Fields("AwayTeam") = TeamNames(AwayTeam)
rstFixtures.Fields("Player2") = TeamNames(Player2)
'rstFixtures.Fields("Age") = Age
rstFixtures.Fields("FixDate") = startdate
rstFixtures.Fields("Leagueno") = intLeagueno
rstFixtures.Update
Next iCounter
startdate = startdate + 7
If startdate > EndDate Then Week = NumberofFixtures + 1
Next Week
'****************************************
'Close the tables
'****************************************
rstTeams.Close
Set rstTeams = Nothing
rstFixtures.Close
Set rstFixtures = Nothing
End Function
A nice patch of code that will allow you to cycle through a series of forms and make them read only. Useful if you don’t have immediate access to make changes to the backend, SQL Server or active directory. If you have any programmatic save record commands you will have to deprecate those lines.
Public Sub turnOffFormProps()
Dim strForm As String, db As DAO.Database
Dim doc As DAO.Document
Set db = CurrentDb
For Each doc In db.Containers("Forms").Documents
strForm = doc.Name
DoCmd.OpenForm strForm, acDesign
Debug.Print Forms(strForm).Properties("AllowAdditions")
Forms(strForm).Properties("AllowAdditions") = False
Debug.Print Forms(strForm).Properties("AllowDeletions")
Forms(strForm).Properties("AllowDeletions") = False
DoCmd.Close acForm, strForm, acSaveYes
Next doc
Set doc = Nothing
db.Close
Set db = Nothing
End Sub
Haven’t tried this out but could be useful. I have a digital mapping web application that I link to from a database and it has issues with IE but works perfectly in Chrome…
shell("C:\Program Files (x86)\Google\Chrome\Application\chrome.exe -url http:google.ca")
Update : 24 June 2014 – just tested this out on a windows 8.1 device and seems to work
%localappdata%\google
Note to self
If you are wanting to pass parameter values between forms ensure that you place public variables in a module outside of the form.
IMPORTANT – additionally ensure that the same variable names are NOT also listed in the function on the form. If you don’t remove the local variables of the same name. Parameters will appear to be set to the public variables but when you try and call them subsequent to the local scope closure they will be blank.
This must mean that variables are set consecutively and transferred into a memory address. If two variables of the identical name are set the first gets one memory address and the second another. Thus they may appear the same but reference different locations. For clarity be careful with your variable definitions!!!!
Most of the time when you are wanting to enter information automatically in fields as a result of a user interaction it is easiest to use some kind of event trigger from the form. Regularly you want to close down a form and alter a field value in a table on a form which is not presently open.
While the events associated with individual fields and the code therein on forms is generally very good at executing code consecutively making it very predictable, it doesn’t always like you calling another field on another form from a different form often producing an error.
In such cases it is better to alter data entry completely programmatically rather than relying on forms to be loaded before altering fields. The code can still be triggered by an event on a form however.
This code looks to a table of Attendees (T008Attendees) on Courses and selects an individual booking based on its reference booking (I have set this to ParameterID).
The letter sent and letter sent date fields are then updated. As many fields as you want could however be updated. Makes for a very nice user experience.
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strSQL As String
Set db = CurrentDb()
strSQL = "SELECT T008Attendees.PKID, T008Attendees.LetterSentDate, T008Attendees.LetterSent FROM T008Attendees WHERE (((T008Attendees.PKID)=" & ParameterID & "));"
Set rst = db.OpenRecordset(strSQL, dbOpenDynaset)
With rst
If .RecordCount > 0 Then
.MoveFirst
.Edit
!LetterSent = 1
!LetterSentDate = Date
.Update
End If
End With
This code is generally available all over the tinternet nonetheless I list it here for my own personal use. I use an autoexec macro to trigger the code on open
With a Run Code action to trigger the AttachDSNLessTable…
So the code in the macro might look something like this
AttachDSNLessTable(“Table01Invoices”,”Table01Invoices”,”Server01″,”AccountingDatabase”,””,””)
Alternatively you could run it from the immediate window of the VBA module section.
Ctrl + G to get the immediate window up then create the function with the required parameters placing a question mark in front of the function eg
?AttachDSNLessTable(“Table01Invoices”,”Table01Invoices”,”Server01″,”AccountingDatabase”,””,””)
Pressing return will result in True result and when you go to the tables section Table01Invoices or your table should appear. Note if you have the tables section open of the database window then you will need to refresh.
Honestly works a treat and you can totally revolutionise processes if you are allowed to use the ease of front end design of something like MS Access with the scalability and power of SQL Server.
Needless to say vendors tend to be universally unwilling to give me details of their(/our!) backends.
'//Name : AttachDSNLessTable
'//Purpose : Create a linked table to SQL Server without using a DSN
'//Parameters
'// stLocalTableName:Name of the table
'// stRemoteTableName: Name of the table that you are linking to on the SQL Server database
'// stServer: Name of the SQL Server that you are linking to
'// stDatabase: Name of the SQL Server database that you are linking to
'// stUsername: Name of the SQL Server user who can connect to SQL Server, leave blank to use a Trusted Connection
'// stPassword: SQL Server user password
Function AttachDSNLessTable(stLocalTableName As String, stRemoteTableName As String, stServer As String, stDatabase As String, Optional stUsername As String, Optional stPassword As String)
On Error GoTo AttachDSNLessTable_Err
Dim td As TableDef
Dim stConnect As String
For Each td In CurrentDb.TableDefs
If td.Name = stLocalTableName Then
CurrentDb.TableDefs.Delete stLocalTableName
End If
Next
If Len(stUsername) = 0 Then
'//Use trusted authentication if stUsername is not supplied.
stConnect = "ODBC;DRIVER=SQL Server;SERVER=" & stServer & ";DATABASE=" & stDatabase & ";Trusted_Connection=Yes"
Else
stConnect = "ODBC;DRIVER=SQL Server;SERVER=" & stServer & ";DATABASE=" & stDatabase & ";UID=" & stUsername & ";PWD=" & stPassword
End If
Set td = CurrentDb.CreateTableDef(stLocalTableName, dbAttachSavePWD, stRemoteTableName, stConnect)
CurrentDb.TableDefs.Append td
AttachDSNLessTable = True
Exit Function
AttachDSNLessTable_Err:
AttachDSNLessTable = False
MsgBox "AttachDSNLessTable encountered an unexpected error: " & Err.Description
End Function
Where Link is a field containing URL.
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
Dim Link As String
Link = Me.Link
Application.FollowHyperlink "http://" & Link