HELP: Excel userform version control issue

[sam]

Hi All,

I have an excel userform that is posted on my companys intranet. The issue I
am having is, users are saving this form to their hard drive and then using
it(Instead of launching it everytime from intranet), SO basically when I
have a new version of form on intranet they still use the old version as they
have a habbit of saving it on their hard drive.

Is there a way to resove this? something like they would see a popup message
saying that "This is an older version that you are using, Please launch the
form from Intranet for newer version".

Thanks in advance

 

[EricG]

Place the following code in the "ThisWorkbook" module of your master form.
Set the value of the "masterFile" constant to whatever path you use for the
master version of your form. Then create a worksheet called "HiddenSheet".
In cell A1, type the label "Version". In cell A2, enter whatever you want
the version number to be. Then password protect that sheet and hide it.
Provide this form to all your users.

When a user opens the form, the "Workbook_Open" routine will run and compare
the version number of the user's file with the master. If they don't match,
the file will be closed.

HTH,

Eric

Option Explicit

Private Const masterFile = "C:\myPath\Master.xls"

Private Sub Workbook_Open()
Dim conData As Object
Dim rstAssigns As Object
Dim intCount As Integer
Dim strSelect As String
Dim strResults As String
'
Set conData = CreateObject("ADODB.Connection")
Set rstAssigns = CreateObject("ADODB.Recordset")
'
' Open a data connection to the "master" form so that we
' can check its version number without opening it.
'
With conData
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Provider=Microsoft.Jet.OLEDB" & _
".4.0;Data Source=" & masterFile & ";Extended " & _
"Properties=""Excel 8.0;HDR=Yes"""
.CursorLocation = 3
.Open
End With
'
' The worksheet named "HiddenSheet" (no $) must be present in
' the "master" file, and on it must be the word "Version" in
' cell A1 and the version number (like 2.1) in cell A2.
'
strSelect = "SELECT * FROM [HiddenSheet$]"
'
On Error GoTo Oops
'
' Open the recordset so we can read the version number
'
rstAssigns.Open strSelect, conData, adOpenStatic, adLockReadOnly,
adCmdText
'
On Error GoTo 0
'
Do While Not rstAssigns.EOF ' We loop, but there is really on one entry
For intCount = 0 To rstAssigns.Fields.Count - 1
'
' Check to see if the master version number and the version
' of this file are the same.
'
' rstAssigns.Fields(intCount).Name is the name of the field ("Version")
' rstAssigns.Fields(intCount).Value is the value of that field (the version
number)
'
If (rstAssigns.Fields(intCount).Value <>
Me.Sheets("HiddenSheet").Cells(2, 1)) Then
MsgBox "Version Number in this file (" &
Me.Sheets("HiddenSheet").Cells(2, 1) & ") " & Chr(10) & _
"does not match version number in master file (" &
rstAssigns.Fields(intCount).Value & ")" & Chr(10) & Chr(10) & _
"Please acquire and use the latest version of the
form." & Chr(10) & Chr(10) & _
"This file will now close." _
, vbOKOnly, "Mismatched Version Number"
Me.Close SaveChanges:=False
End If
Next
rstAssigns.MoveNext
Loop
'
' Close the data connection
'
conData.Close
Set conData = Nothing
Set rstAssigns = Nothing
'
Exit Sub
'
Oops:
Debug.Print "Oops! Unable to read the master file's version number."
Debug.Print "Error Message: " & Err.Description
End Sub