Stop users closing forms before submitting them

So I was asked recently how to stop people leaving a web page without hitting the submit button on the form they were filling in.

It turns out people were registering for an event but the hastily put together form had little sense checking and a number of people had filled in the (very long) form but hadn't hit the submit button. They thought they were registered for the event but their details weren't saved.

In general, individuals may be smart but sure as hell, people are dumb dumb dumb. If there's a chance someone will do something weird with a form, you can bet they will.

Luckily, warning them when they try to navigate away from the page their on is pretty easy.

Step 1

Stick this in the head of your page:

<script language="javascript">

function unloadMsg(){

    msg = "You haven't finished filling in your form."

    return msg;

}

function setUnload(on){

    window.onbeforeunload = (on) ? unloadMsg : null;

}

setUnload(true);

</script>

Step 2

Any button or link that should actually let them leave the page without warning should have this added to it:

onclick="window.onbeforeunload = null;"

Job done!

Example

<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">

<html xmlns="http://www.w3.org/1999/xhtml">

<head>

<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />

<title>Please don't leave!</title>

<script language="javascript">

function unloadMsg(){

    msg = "You haven't finished filling in your form."

    return msg;

}

function setUnload(on){

    window.onbeforeunload = (on) ? unloadMsg : null;

}

setUnload(true);

</script>

</head>

<body> 

<h1>Please Don't Go Test</h1>

<p>To test:

<ul>

	<li>Try closing this page</li>

	<li>Navigate to <a href="http://www.google.com">Google</a> with warning still turned on</li>

	<li>Turn off warning and navigate to <a href="http://www.google.com" onclick="window.onbeforeunload = null;">Google</a></li>

</ul>

</p>

</body>

</html>

Chunk - it's only your echo

Don't feel unloved if you haven't received an email in the last 20 minutes. Sometimes they may just be stuck somewhere!

I've used the tu-berlin echo service for years now as a very simple test before I do further investigation but I'm constantly surprised that few have heard of it.

Just send an email to echo@tu-berlin.de and they'll send one straight back to you.

Copper Egg - server and website monitoring

Recently I've been playing around with some new low cost monitoring services.
For a long while I used to use Monitorus on an ad-hoc basis but there's some newer ones that are well worth  looking at.
G introduced me to CopperEgg which seems particularly interesting. With the free version you can install server monitoring agents on up to 2 servers and monitor uptime/response times of up to 30 websites.
Perfect for SMEs and charities.

EU Cookie Acceptance Plug-in for Joomla

I'm just putting the finishing touches to a Cookie Acceptance Plug-in for both Joomla 1.5 & 2.5.
I should have it finished and published on  Joomla extensions in the next week if all the testing goes to plan.
The plugin stops Joomla creating any cookies unless the user has accepted the site's T&Cs.
The acceptance bar css can be different for each template (useful if you have mobile versions or you allow users to switch templates from the front end). It works with language files, allowing different text to be displayed depending if you are reading in English, German, etc.

Watch this space.

AD Users with nested group memberships

I was recently working on a single domain which contained a lot of nested security groups (ie one group was a member of another, which in turn was a member of another etc.).
This kind of model can be useful to place a user account in one security group and automatically belong to many. However this can be a nightmare to diagnose if something goes wrong!
So here's a script I've had in my box of tricks for a while that should help. It outputs a list of users and all their group memberships (including the nested ones).

'==== SETTINGS ====================

' start ad path for user list
strOU = "OU=Site01,OU=Staff"


'==================================
If Right(LCase(WScript.FullName), 11) = "wscript.exe" Then
      Set objShell = CreateObject("WScript.Shell")
      objShell.Run "cscript """ & WScript.ScriptFullName & """", 1, False
      Set objShell = Nothing
      WScript.Quit
End If



Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection

 ' Search entire Active Directory domain.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")

If Right(strOU, 1) <> "," Then strOU = strOU & ","
strBase = ""

strFilter = "(&(objectCategory=person)(objectClass=user))"

' Comma delimited list of attribute values to retrieve.
strAttributes = "ADsPath"

' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False

' Run the query.
Set adoRecordset = adoCommand.Execute


' Enumerate the resulting recordset.
Do Until adoRecordset.EOF
      WScript.Echo ""
      WScript.Echo "Proccessing: " & adoRecordset.Fields("ADsPath").Value

    ' Retrieve values and display.
      Set objUser = GetObject(adoRecordset.Fields("ADsPath").Value)

      strResults = ""
      strGroups = ""
     
      intLevel = 0
     
      GetMemberOfNames objUser, intLevel
     
      strResults = Replace(objUser.Name, "CN=", "") & " is a member of: "
      arrGroups = Split(strGroups, VbCrLf)
      For intCount = LBound(arrGroups) To UBound(arrGroups)
            If strResults = "" Then
                  strResults = arrGroups(intCount)
            Else
                  strResults = strResults & VbCrLf & arrGroups(intCount)
            End If
      Next

      Set objUser = Nothing

      WScript.Echo ""
      WScript.Echo strResults

      adoRecordset.MoveNext
Loop

' Clean up.
adoRecordset.Close
Set adoRecordset = Nothing

adoConnection.Close

MsgBox "Done. Please see text file " & strOutputFile


'==== Sub's and Functions =========

Sub GetMemberOfNames(objObjectToCheck, intLevel)
      ' This function can get caught in a loop if there is a circular
      ' group membership.  There is a method of using a Dictionary object
      ' here: http://www.rlmueller.net/MemberOf.htm
      ' which checks if the group has been used before.
     
      intLevel = intLevel + 1
      ' Retrieve ALL of the user groups that a user is a member of
      On Error Resume Next
      objMemberOf = objObjectToCheck.GetEx("MemberOf")
      If Err.Number = 0 Then
            On Error GoTo 0
            For Each objGroup in objMemberOf
                  strGroupName = Left(Mid(objGroup, InStr(objGroup, "CN=") + 3),InStr(Mid(objGroup, InStr(objGroup, "CN=") + 3), ",") - 1)
                  If strGroups = "" Then
                        strGroups = String(intLevel, chr(9)) & strGroupName
                  Else
                        strGroups = strGroups & VbCrLf & String(intLevel, chr(9)) & "o " & strGroupName
                  End If
                  Set objNextGroup = GetObject("LDAP://" & objGroup)
                  GetMemberOfNames objNextGroup, intLevel
            Next
            intLevel = intLevel - 1
      Else
            intLevel = intLevel - 1
            Err.Clear
            On Error GoTo 0
      End If
End Sub

NB: Usually I stick some comments at the top of code so I know the source. I've had this so long that really can't remember if I wrote this or modified someone else's code. So if the above looks familiar, drop me an email and I'll give you credit!

Quick & Nasty Email Alias Extraction

Sitting on an old Exchange 2003 server the other day, I needed a quick list of all the email addresses (including aliases). Being a bit old school the easiest thing for me to do was slap together a batch file to give me the answer. So to save me (and anyone else) the effort if I ever have to do it again, here it is:

@echo Off
ldifde -f %TEMP%\ldifde-dump.txt -l proxyaddresses
find "proxyAddresses: " < %TEMP%\ldifde-dump.txt > %TEMP%\ldifde-dump.filter1.txt
find "@" < %TEMP%\ldifde-dump.filter1.txt > %TEMP%\email-addresses.txt
del %TEMP%\ldifde-dump.txt
del %TEMP%\ldifde-dump.filter1.txt
notepad %TEMP%\email-addresses.txt

Handy SQL Functions: Number List

Sometimes, in SQL group queries, you need totals over a series(e.g. Month numbers 1 to 12). What do you do if some parts of that range have no data but you still want the number in the series displayed?

For instance in our example you have sales data for Month 1,2,3,5 & 6 but there isn't anything for month number 4. You still want Month 4 displayed as a row, just with a null value.

The easiest way to do this is have a small table with numbers 1 to 12 that you can LEFT JOIN on to.

This function will output a table just like that.

CREATE FUNCTION dbo.fnNumberList
(
 @iStart int,
 @iEnd int,
 @iStep int = 1
)  
RETURNS @RtnValue table 
(
 ircNum int
) 

/*
 Returns a table with column name "ircNum" numbers from iStart to iEnd incrementing/decrementing by iStep
 Example:
 select * from dbo.NumberList(4,10,2);
 
 ircNum
 ------
 4
 6
 8
 10
*/

AS  
BEGIN 
 Declare @Cnt int
 Set @Cnt = @iStart

 if @iStep>0 
 While (@Cnt<=@iEnd)
 Begin
  Insert Into @RtnValue (ircNum) VALUES (@Cnt)
  Set @Cnt = @Cnt + @iStep
 End

 if @iStep<0 
 While (@Cnt>=@iEnd)
 Begin
  Insert Into @RtnValue (ircNum) VALUES (@Cnt)
  Set @Cnt = @Cnt + @iStep
 End
 
 Return
END

Handy SQL Functions: Reverse Week Number

I thought it was about time I posted some of the random little functions I've created in SQL that I use now and then.

So here's the first. It's very easy in SQL to get a week number (1..53) from a date - just use "datepart". However doing the reverse isn't. Say, for instance you wanted to know what the date was at the start of week 27 in 2012. How would you go about working that out? Here's my solution.

Just supply the function with the week number and year and out pops the date.

CREATE FUNCTION dbo.fnGetDateFromWeekNo
(@weekNo int , @yearNo  int)
RETURNS smalldatetime
AS
BEGIN 

DECLARE @tmpDate smalldatetime

IF @weekNo<1 set @weekNo=1

set @tmpdate= cast(cast (@yearNo as varchar) + '-01-01' as smalldatetime)
-- jump forward x-1 weeks to save counting through the whole year 
set @tmpdate=dateadd(wk,@weekno-1,@tmpdate)

-- make sure weekno is not out of range
if @WeekNo <= datepart(wk,cast(cast (@yearNo as varchar) + '-12-31' as smalldatetime))
BEGIN
 WHILE (datepart(wk,@tmpdate)<@WeekNo)
 BEGIN
  set @tmpdate=dateadd(dd,1,@tmpdate)
 END
END
ELSE
BEGIN
 -- invalid weeknumber given
 set @tmpdate=null
END


RETURN @tmpDate

END

Way too addictive - Circuit Coder

Ok, let's get one thing straight. I don't do games. I spend enough time at a computer that I'd rather go out in the fresh air after hours. Hacking zombies, casting spells and boosting cars just ain't my thing.
However I do like a puzzle; Something aching to be solved. I just can't stop picking at a problem until I've understood it and solved it.

Unfortunately for me, I stumbled across Circuit Coder. Ooooh it's addictive. I've only had it on the iPad for an evening and I've already chomped through a fair chunk of the levels.

The idea of the game (and bear with me on this) is to build a circuit to solve the challenge set.
Like most of these style of puzzles, you have blocks that perform different functions that you can connect together to achieve your goal. However, unlike most, these blocks aren't paint pots, cogs or springs, but electrical circuit diagrams. Dispensing with the usual visual analogies and going straight for logical diagrams makes for a refreshing change.

The interface is clean and easy to understand, making game-play easy even if some of the challenges are deceptively difficult.
It's definitely not for everyone. If I hadn't done some electronics at uni, I'm not sure if I would have understood some of the logic gate terminology straight away. But perhaps I'm being unfair here. It's got a concise help and beginner/tutorial levels that get you into the swing of things.

If you like a challenge and don't mind looking like a geek - give it a go!

MS Access Hebrew Dates Class (revisited)

This article has been updated and is now available here.

I've just finished the new version of the Hebrew Dates code.
All thanks to Moishy at Access World Forums for some really useful feedback on the original.
The new version can be downloaded for free via:

• 4Shared
• Access World Forums

Here's a description of the functionality

clsHebrewDate Class
  PROPERTIES
    .HDay
        Read/Write (long)
        stores the value of the current Hebrew day
        When set, the Gregorian Date will automatically be updated.
    .HMonth
        Read/Write (long)
        stores the value of the current Hebrew month
        When set, the Gregorian Date will automatically be updated.
    .HYear
        Read/Write (long)
        stores the value of the current Hebrew year
        When set, the Gregorian Date will automatically be updated.
    .HDaysInMonth
        Read Only (integer)
        returns the number of days in current Hebrew month.
    .GDate
        Read/Write (date)
        stores the value of the current Gregorian Date
        When set, the Hebrew Date will automatically be updated.
    .GAfterSunset
        Read/Write (boolean)
        used to mark the Gregorian date as occuring after sunset.
        NB: Gregorian days start at midnight but Hebrew days start
        after sunset
        TRUE = After sunset
        FALSE = Before sunset
        When set, the Hebrew Date will automatically be updated.
    .IsHLeapyear
        Read Only (boolean)
        Returns TRUE if the current Hebrew Year is a Hebrew leapyear
        NB: Hebrew leap years include a whole extra month (Adar II)
        and occur in a pattern that follows a 19 year cycle (see below)
    .IsValid
        Read Only (boolean)
        Returns TRUE if the current Hebrew Date is valid
  METHODS
    .Copy()
        Function returns clsHebrewDate type
        Creates and returns a new copy of the current instance
        of the clsHebrewDate class.
    .SetHebrewDate()
        Sets the Hebrew date and automatically updates the Gregorian
        date.
    .YahrzeitStep([,])
        Alters the current Hebrew Date moving it forward or backward
        x years according to the value of YearStep in accordance with
        the selected algorithm selected by CalcStyle.
        NB: You should always calculate additional Yahrzeit dates from
        the orginal date of the aneversary. DO NOT be tempted to calc
        a Yahrzeit from a previous Yahrzeit! This will lead to errors!
        YearStep: integer value can be positive or negative
        CalcStyle: (OPTIONAL)
                    1: Traditional (DEFAULT)
                    2: Reform
                    3: CatchAll

Module modHebrewDate
Function's
 GetHebrewMonthsList(bLeapYear As Boolean) As Variant
  returns a list of month numbers and their names delimited with semicolons
  this is particularly useful for generating combobox dropdown lists
  NB: Hebrew leap years have a extra month, hence the need for bLeapYear 
  to specify if the list should generate months for a leap year

 FormatHDate(myDate As clsHebrewDate, myFormat As Variant) As Variant
  Format hebrew date and output as a variant string.
  Variant string is needed so unicode letters can be used i.e. for Hebrew text
  the format parameters are based on the ones uses in PHP. See http://php.net/manual/en/function.date.php
  Format codes:
   Misc
    \ escape character
   Day
                d Date, 2 digits with leading zeros (00..30)
                f Textual representation of date as stored in the language table (HDate01..HDate30)
                j Date as number without leading zeros (1..30)
                l NB: this is a lowercase letter L
     Textual representation of the day of the week as stored in the language table (HDay1..HDay7)
                S English ordinal suffix for the day of the month, 2 characters (st, nd, rd, th)
                w returns 1..7 where 1=Sunday (Yom Rishon)
   Month
                F Textual representation of a month as stored in the language table
     (HMonth01..05, HMonth07..13, HMonth06Leap, HMonth07Leap)
                m Numeric representation of a month, with leading zeros (01..13)
                n Numeric representation of a month, without leading zeros (1..13)
                t Number of days in the given month (29..30)
   Year
                L Whether it's a leap year (1=yes 0=no)
                Y A full numeric representation of a year, all digits (eg 5758)
                y A two digit representation of a year (eg 58)
   Time
                a Textual representation of time of day in the Gregorian Date part as stored in Language Table (GTimeNight, GTimeDay)
Sub's
 SetHebrewDateFromGUI(ByRef MyHebrewDate As clsHebrewDate)
  Shows a hebrew date picker dialog box and returns any selected date back to the carable passed to MyHebrewDate
  NB: if you prefer the dialog box to display in Right to Left mode and have days that change according to the hebrew
  rather than the gregorian calendar (i.e. at sunset rather than midnight) edit the dlgHebDatePick13/14 form and set
  Const CDisplayRTL = True
  
  
  

Internationalisation in Access

Working with Joomla, I'm used to messing around with language files for the user interface.
Each language file supplies text that should be displayed (as part of the interface) to the user depending on their language.
So today, I decided it was high time I built something similar in Access. Below is the (surprisingly easy) result, using Kernel32 to identify the current language of the user...

First of all you'll need a table to store your text. Access text fields store text as unicode so you can even include text from right-to-left languages like Arabic or Hebrew.

The table will need 3 fields

1. swmVar to store the variable name
   Type: Text
   Size: 25
   Required: Yes
   Input Mask:  >Aaaaaaaaaaaaaaaaaaaaaaaaa
2. lwmLanguageID to store the ID of the Language the text is for
   Type: Long (Long Integer)
   Required: Yes
   Default Val: 0
3. swoData to store the text itself
    Type: Text
   Size: 255

I can't think of a reason why table would need a primary key but it does need to make sure that you don't store duplicate values of swmVar within the same Language ID so for ease I've set swmVar + lwmLanguageID as a composite primary key. However, you could create a separate primary key and just have these to fields as a composite unique index.

NB: I'm using my standard naming convention here where the first letter of the field represents the field type, the 2nd notes if the field is editable (w=write, r=read-only) and the 3rd shows if the field is optional (o) or mandatory (m).

Next you'll need the module
Module: ModLanguage

Option Compare Database
' Module to assist internationalisation of database interface
' written by Marc Ozin
' version: rc2012.02.02
' Website: http://marcozin.blogspot.com


' this module requires a lanaguage table like this:

' Table Name: tblLanguage
' Fields:
'   swmVar
'       Type:        Text
'       Size:        25
'       Required:    Yes
'       Input Mask:  >Aaaaaaaaaaaaaaaaaaaaaaaaa
'   lwmLanguageID
'       Type:        Long Integer
'       Required:    Yes
'       Default Val: 0
'   swoData
'       Type:        Text
'       Size:        255
'
' Primary Key: Composite of swmVar & lwmLanguageID
'
' this table will store language varables & text for each lanaguage code
' plus language varables & text to default to if language code not found
' signifed using lwmLanguageID of zero (0)

' Notes:
' Table of Locale ID's can be found on these pages:
' http://msdn.microsoft.com/en-us/goglobal/bb895996
' http://msdn.microsoft.com/en-us/goglobal/bb964664

' Examples:
' to set the caption for the button called ButtonCancel in a form when it opens
' edit the OnLoad event for the form and insert the following line:
'   ButtonCancel.Caption = GetLangTxt("CANCEL")
' Then in the language table create a row with these values:
'   swmVar:         CANCEL
'   lwmLanguageID:  0
'   swoData:        &Cancel
' "&Cancel" will be the default text when a particular user's language cannot be found
' to have different text for German, add the following row:
'   swmVar:         CANCEL
'   lwmLanguageID:  1031
'   swoData:        &Kündigen




'Get the language ID for the current user's locale from kernel32
'returns Long number representing the Language ID
Public Declare Function GetUserDefaultLCID% Lib "kernel32" ()


Public Function GetLangTxt(sLangVar As String, Optional ByVal lLanguageID As Long = -1) As String
' returns language text from specified variable stored in the Language Table
' function will try and return text for specified varable for current language (or language specified by lLanguageID)
' if no text found, then it will try and return text for varable with a language id of zero
' if still no text found, then it will return the name of the varable incased in square brackets

Const cLanguageTable = "tblLanguage"
Const cLanguageDataField = "[swoData]"
Const cLanguageVarableNameField = "[swmVar]"
Const cLanguageIDField = "[lwmLanguageID]"

Dim vTemp As Variant
    
    If lLanguageID = -1 Then
        lLanguageID = GetUserDefaultLCID()
    End If

    'try for a specific language id
    vTemp = DLookup(cLanguageDataField, cLanguageTable _
    , cLanguageVarableNameField & " like '" & UCase(Trim(sLangVar)) & "' and " & cLanguageIDField & "=" & CStr(lLanguageID))
    
    ' if nothing found
    If IsNull(vTemp) Then
        'try for language zero
        vTemp = DLookup(cLanguageDataField, cLanguageTable _
        , cLanguageVarableNameField & " like '" & UCase(Trim(sLangVar)) & "' and " & cLanguageIDField & "=0")
    End If
    GetLangTxt = Nz(vTemp, "[" & sLangVar & "]")
End Function

Here's an example of how to set the caption for the button called ButtonCancel in a form when it opens.

1. edit the OnLoad event for the form and insert the following line:

   ButtonCancel.Caption = GetLangTxt("CANCEL")

2. Then to set "&Cancel" as the default text when a particular user's language cannot be found, in the language table create a row with these values:
   
   • swmVar: CANCEL
   • lwmLanguageID: 0
   • swoData: &Cancel
3. to have different text for German, add the following row:
   
   • swmVar: CANCEL
   • lwmLanguageID: 1031
   • swoData: &Kündigen

Google Groups Invites not being received

At work we've been getting a lot of people reporting that they've been invited to a private google group but haven't received the invite. The Group moderator says they sent the invite but the recipient never received it.

It took a while but I think I have an answer. At least, I have a fix if you are using Trend Micro IMSS to check your mail before it is delivered to your internal mail servers.

It might be to do with the length of the email address that google's server uses to send the invite.
As soon as IMSS started to receive the invite email, it would drop it as invalid.

The invite email header's MAIL-FROM address was: "grbounce-v69lOAUEAEBnNWTkA5m_texcgVeUF-2Q=xxxxxxx=xxxxxxxxx.org.uk@googlegroups.com"
(I've replaced my details with x's above)

According to the official RFC (#3696) the part of the address before the @ sign must be no longer than 64 characters long.
The Google Groups invite email was 66 characters long, so our mail server was rejecting them as invalid.

“In addition to restrictions on syntax, there is a length limit on
email addresses. That limit is a maximum of 64 characters (octets)
in the "local part" (before the "@") and a maximum of 255 characters
(octets) in the domain part (after the "@") for a total length of 320
characters. Systems that handle email should be prepared to process
addresses which are that long, even though they are rarely
encountered.”

Extract from page 6 of RFC3696: http://tools.ietf.org/html/rfc3696


To stop IMSS checking the length of the MAIL-FROM address we added the following line in tsmtpd.ini in the [SmtpServer] section:

CheckSenderLength=0

Hope this helps someone!

Hebrew Dates as Class Module in Access

See new post with updated version!
Recently I've been messing around with a neat bit of code written to explain how to calculate Hebrew dates (which are based on a Lunar calendar).
I've extended it's functions, building it into a Class; creating Yartzeit calculation functionality (using Progressive, Traditional and Catch-All options); and hebrew date picker GUI dialogs.

You can find my first version of this code here:
http://www.4shared.com/file/_5c5GJcP/hebrewDates.html
or
http://www.access-programmers.co.uk/forums/attachment.php?attachmentid=40063

The file is is Access2010 format and contains an example form to show some of it's features.

NB you can open the file in Access 2007 but 2007 doesn't support the .BackColor property for Buttons so you'll need to alter this in the dlgHebDatePick code inside the Draw_MonthButtons Sub.

See new post with updated version!

Change Trigger - Log all data changes in a table

I needed a MSSQL trigger to store alterations to data in a table called tblContacts. All changes (i.e. the before & after values) needed to be stored in a table that logs all changes from various tables.

tblAudit Structure

irpEditRecordID (int)
dwoEditDate (datetime)
swoUser (nvarchar)
cwoAction (char)
swoRecordID (nvarchar)
swoSourceTable (nvarchar)
swoSourceField (nvarchar)
swoBeforeValue (sql_variant)
swoAfterValue (sql_variant)

This is a bit quick and nasty, and probably a bit slow if you've got a table that really gets hammered but it suits my needs. The trigger below will spin through all available fields looking for changes and log them in tblAudit. The payoff is I don't need to remember to update the trigger if I add new fields!

tblContacts Update Trigger

SET QUOTED_IDENTIFIER ON 
GO
SET ANSI_NULLS ON 
GO

-- Change the trigger name below to reflect your table name
CREATE TRIGGER trg_tblContacts_Update

-- Change the table name below to reflect the table you want to audit
ON dbo.tblContacts

FOR UPDATE

AS

DECLARE @sField    VARCHAR(255)
DECLARE @sTable    VARCHAR(255)
DECLARE @sPrimaryKey  VARCHAR(255)
DECLARE @sSQL    VARCHAR(3000)

-- SETTINGS --
-- Change the table name below to reflect the table you want to audit
SET @sTable = 'tblContacts'
-- Change the primary key below to reflect the primary key field for table you want to audit
SET @sPrimaryKey = 'irpContact'

-- INIT --
SET @sSQL = ''

SELECT  * INTO #temp_inserted FROM inserted;
SELECT  * INTO #temp_deleted FROM deleted;


DECLARE fields_cursor CURSOR FOR 
 SELECT column_name FROM information_schema.columns
  WHERE table_name = @sTable
 ORDER BY ordinal_position
OPEN fields_cursor

-- CHECK CHANGES TO DATA IN EACH FIELD --

FETCH NEXT FROM fields_cursor INTO @sField

WHILE @@FETCH_STATUS = 0
BEGIN

 -- Find and log changes in tblAudit
 SET @sSQL = ' INSERT INTO tblAudit  (dwoEditDate,swouser,cwoAction,swoRecordID,swoSourceTable,swoSourceField, swoBeforeValue,swoAfterValue) ( select GETUTCDATE() as calc_datestamp, system_user as calc_username, ''A'' as calc_status, #temp_inserted.' + @sPrimaryKey + ', ''' + @sPrimaryKey + ''' as calc_TableName, ''' + @sField + ''' as calc_fieldname,  #temp_deleted.' + @sField + ', #temp_inserted.' + @sField + ' from #temp_inserted , #temp_deleted  where (#temp_deleted.' + @sPrimaryKey + ' = #temp_inserted.' + @sPrimaryKey + ') AND (#temp_inserted.' + @sField + ' != #temp_deleted.' + @sField + ' ) ) '
 
--PRINT @sSQL
 EXEC(@sSQL)

 FETCH NEXT FROM fields_cursor INTO @sField
END

CLOSE fields_cursor
DEALLOCATE fields_cursor



GO
SET QUOTED_IDENTIFIER OFF 
GO
SET ANSI_NULLS ON 
GO

Reports in Forms

You learn something new every day! I had no idea that in MS Access 2010 you could embed Reports inside Forms (new feature definitely not available in Access 2007).
See: http://social.technet.microsoft.com/Forums/en-US/office2010/thread/78dd8a46-1281-47b7-84e8-125c56e13b2a#6aaa6cf0-af99-49e7-96ee-3ab12a043b7b

That might come in very handy with displaying a list html formatted notes in a form.

Now to have a play...

Displaying a 6 digit number as 4 text characters

Recently I had to link up 2 systems, one financial off the shelf package and a bespoke Access database used for contact management.
The contact management data was going to create and maintain customer accounts in the financial package. The problem was in the access DB each contact had a unique number and in the financial package we needed a reference where the first 2 letters of the customers surname were followed with up to 4 more characters for a unique reference.
Tricky.
In the end I put together this short bit of code that allows you to convert a number to any base. All you have to do is supply the digits to use.
In my case I've used base 33 to pack the id numbers into a shorter format using numbers and letters.

Const vbB2Digits = "01" 'base 2 - Binary
Const vbB8Digits = "01234567" 'base 8 - Octal
Const vbB10Digits = "0123456789" 'base 10 - Decimal
Const vbB10Digits = "0123456789XE" 'base 12 - Dozenal. See http://www.dozenal.org
Const vbB16Digits = "0123456789ABCDEF" 'base 16 - Hexedecimal
Const vbB33Digits = "0123456789ABCDEFGHJKMNPQRSTUVWXYZ" 'base 33 - non similar characters (I,L,O removed) from 0-9 & Alphabet


Public Function sEncodeNumber(lNumber As Long, Optional sDigitList As String = vbB10Digits) As String
Dim sOutputString As String
Dim lTmpNumber As Long
Dim lRangeSize As Long
Dim lTmpPower As Long
Dim lTmpLastPower As Long

    OutputString = ""
    lTmpNumber = lNumber
    lRangeSize = Len(sDigitList)
    lTmpPower = 1

    ' Work with postive numbers
    If lTmpNumber < 0 Then
        lTmpNumber = lTmpNumber * -1
    End If

    While lTmpNumber > 0
        lTmpLastPower = lTmpPower
        lTmpPower = lTmpPower * lRangeSize
        sOutputString = Mid(sDigitList, ((lTmpNumber Mod lTmpPower) / lTmpLastPower) + 1, 1) & sOutputString
        lTmpNumber = lTmpNumber - (lTmpNumber Mod lTmpPower)
    Wend

    ' insert the -ve sign if the orginal number was negative
    If lNumber < 0 Then
        sOutputString = "-" & sOutputString
    End If

    sEncodeNumber = sOutputString
End Function

For those maths geeks out there, if you haven't come across dozenal before, have a quick gander at Alex Bellos' blog entires on the subject.

Roll out WPKG Client using AD Group Policy

Using Microsoft's Orca tool to create an MST to work alongside the WPKGSetup.msi is a complete faff especially considering the end goal is rolling out a system that

will handle package management and rollout. Instead why not leverage WPKG to install it's own client?
The major advantage of doing this is that it allows you to upgrade and change WPKG Client parameters in the future using WPKG itself.

So this is how you do it:

First create a WPKG-Client package like this:

<package
   id="gplwpkgclient"
   name="WPKG Client 1.3.9"
   revision="2011.11.05.00"
   reboot="false"
   priority="99999">
 
 <!-- because the client hasn't been installed yet we cannot use the SOFTWARE parameter for paths -->
 <variable name="PKG_PATH" value="\\myserver\myshare\software\Components\gpl.wpkg.client.1.3.9" />
 
 <check type="uninstall" condition="exists" path="WPKG" />
 <check type="file" condition="versionequalto" path="%PROGRAMFILES%\wpkg\wpkginst.exe" value="1.0.0.18" />
 
 
   <install cmd='msiexec /i "%PKG_PATH%\WPKG Client 1.3.9-x32.msi" /qn SETTINGSFILE="%PKG_PATH%\settings.xml"' />
 
   <upgrade cmd='msiexec /i "%PKG_PATH%\WPKG Client 1.3.9-x32.msi" /qn SETTINGSFILE="%PKG_PATH%\settings.xml"' />
 
   <remove cmd='MsiExec /x{08DF8731-5B69-4709-979A-CC08E49D7686} /qn' />
 
</package>

Then in Active Directory, create a new Group Policy object with the following setting:
Computer Configuration → Windows Settings → Scripts(startup/shutdown) → Startup
Script: \\myserver\myshare\wpkg.js
Parameters: /install:gplwpkgclient /quiet

Job done!

The startup script will get WPKG to check if the latest version of the client has been installed every time the PC boots up but will only go through the installation process if no version exists or the current version installed does not match the revision number on the local PC's xml file.

And yes before you ask, I've added this to the wiki at www.wpkg.org.

MSSQL Calls through ODBC in MS Access

As MS Access no longer supports .adp projects any Access databases created have to link to MS-SQL back ends through ODBC.
However, sometimes you still need to call Stored Procedures, Views or create dynamic query statements to be passed directly to MS-SQL.

You can still achieve this by creating a passthru query in Access.

Below is a little bit of code I put together to allow you to run SQL statements using a passthru query called "SQLCall" or choosing one of your own.

To set things up, you'll need to create a passthru query in Access (see http://support.microsoft.com/kb/303968 for how to do this) called SQLCall and then drop this code into a module:

Public Sub SQLExec(ByVal sSQL As String _
 , Optional bRetRecords As Boolean = False _
 , Optional bExecute As Boolean = True _
 , Optional sQueryName As String = "SQLCall" _
 , Optional vConnect As Variant)
 
' vConnect   : Optional connection string
' bRetRecords   : Optional set return records on / off. Default: on
' sQueryName : Optional set alternate location for query storage

On Error GoTo ErrorHandler

Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim sConnect As String

 Set db = CurrentDb
 Set qdf = db.QueryDefs(sQueryName)
 If IsMissing(vConnect) Then
  sConnect = qdf.Connect
 Else
  sConnect = CStr(vConnect)
 End If
 
 qdf.SQL = sSQL
 qdf.Connect = sConnect
 qdf.ReturnsRecords = bRetRecords
 If bExecute Then qdf.Execute

 GoTo ErrorExit
ErrorHandler:
 Select Case Err.Number
 Case Else
  MsgBox cErrorIntro & vbCrLf _
  & vbCrLf & Err.Number _
  & vbCrLf & Err.Description _
  & vbCrLf & Err.Source _
  , vbCritical + vbOKOnly, "Error"
 End Select
 Resume Next
ErrorExit:
End Sub

You can use this Sub to do thinks like:

Call the untag all contacts stored procedure

SQLExec "EXEC spUntagAllContacts;", False, True

Delete Contact #5

SQLExec "DELETE FROM tblContacts Where ContactID = 5;"

Call the SP to tag a contact based on ContactID

SQLExec "EXEC spTagContact " & Nz(ContactID, 0) & ";"

Do a select query and make the results accessible from the SQLContactList passthru

SQLExec "SELECT * from tblContacts WHERE ContactID < 100;", True, False, "SQLContactList"

Call the stored procedure to get the current users security groups and make the results accessible from the SQLSecurityGroupList passthru

SQLExec "EXEC spListMySecurityGroups '" & UserName & "';", True, False, "SQLSecurityGroupList"

Viewing a Nested Set Model tree as an Adjacency List

Recently, I needed to view a Nested Set Model tree as an Adjacency list so I could use it with VB's TreeCtrl.

Here's the MS-SQL view I came up with:

SELECT   T1.irpCategory, T1.iwmleft, T1.iwmright, T1.swmCategoryName, T1.ircDepth, T2.ircParentID
FROM     (SELECT   TOP 100 PERCENT node.irpCategory, node.iwmleft, node.iwmright, node.swmCategoryName, (COUNT(parent.swmCategoryName) - 1) 
                       AS ircDepth
            FROM     dbo.tblCategories AS node, dbo.tblCategories AS parent
            WHERE   node.iwmleft BETWEEN parent.iwmleft AND parent.iwmright
            GROUP BY node.irpCategory, node.swmCategoryName, node.iwmleft, node.iwmright
            ORDER BY node.iwmleft) T1 LEFT OUTER JOIN
             (SELECT   TOP 100 PERCENT irpCategory,
                            (SELECT   TOP 1 irpCategory
                             FROM     dbo.tblCategories t2
                             WHERE   t2.iwmleft < t1.iwmleft AND t2.iwmright > t1.iwmright
                             ORDER BY t2.iwmright - t1.iwmright ASC) AS ircParentID
              FROM     dbo.tblCategories t1
              ORDER BY iwmright - iwmleft DESC) T2 ON T1.irpCategory = T2.irpCategory

And the VB for the TreeCtrl object called tvCategories:

Private Sub Refresh_tvCategories()
On Error GoTo Err_Handler
Dim vNodeSet As Variant
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim bFirstItem As Boolean
Dim sFirstKey As String
    Set db = CurrentDb
    'SQLCategoriesList is a odbc passthru query to the view on the MSSQL server
    Set rs = db.OpenRecordset("SELECT * FROM SQLCategoriesList")
    bFirstItem = True
    
    
    If Not rs.EOF Then
        rs.MoveFirst
        While Not rs.EOF
                        

            If IsNull(rs.Fields("ircParentID")) Then
                Set vNodeSet = tvCategories.Nodes.Add()
                vNodeSet.Key = "K" & rs.Fields("irpCategory")
                vNodeSet.Expanded = False
                vNodeSet.Text = rs.Fields("swmCategoryName")
            Else
                'Tree Controls need text for their IDs so I'm prefixing the ID numbers with the letter K
                Set vNodeSet = tvCategories.Nodes.Add("K" & rs.Fields("ircParentID"), tvwChild)
                vNodeSet.Key = "K" & rs.Fields("irpCategory")
                vNodeSet.Expanded = False
                vNodeSet.Text = rs.Fields("swmCategoryName")
            End If
            If bFirstItem Then
                sFirstKey = vNodeSet.Key
                bFirstItem = False
            End If
            rs.MoveNext
        Wend
    End If
    
    'for some reason the form doesnt work properly unless an item has been selected at some point
    tvCategories.Nodes(sFirstKey).Selected = True
    'it can be unslected straight away
    
    
    
Exit_Err_Handler:
    Exit Sub
    
Err_Handler:
    Select Case Err.Number
       Case vbObjectError + 1
          Resume Next
       Case Else
          msgbox Err.Number & Err.Description
          Resume Exit_Err_Handler
    End Select

End Sub

RTFM! Let me google that for you

G. just showed me the LMGTFY site.

using links like this, you can remind people to try searching before asking obvious questions:
http://lmgtfy.com/?q=Search Terms

e.g.
http://lmgtfy.com/?q=how long is a piece of string
http://lmgtfy.com/?q=8 feet in meters