Quantcast
Channel: dBforums – Everything on Databases, Design, Developers and Administrators
Viewing all articles
Browse latest Browse all 13329

How to update a front end across a network with restricted access.

$
0
0
While the explanation is probably more complicated than the code itself is, I'll try to be brief.

I have an Access Database at my workplace. The back-end is deployed on a network that all users have access to and each person has their only profile at their workstations; typical network layout. The issue with my database is I do not have administrator access to deploy my update to all users, so I have to rely on the user themselves to update their own front-end. This is can be a big issue as a lot of you may know if your co-workers aren't exactly...well...computer people.

What I've done to the Front-End homepage is add a label control that displays the current version that the user is using. The label is linked to a simple table with only one text field. An administrator panel allows an admin to change the version number. Some simple VBA on the front end recognizes when the label control doesn't match up to the back-end's version and a big blue, hard to miss, dummy noticeable "New Update Available" button pops up which invokes the script. (Funny thing is, I still have to prod them to click the darn thing). "Did you click the blue button?" "No." "....".

The cool thing, (I think it's pretty cool) the user can still use an old version providing they don't delete the front-end manually. They just won't be able to access new features and stuff without updating.

The script itself is pretty self-explanatory, but I'll provide a brief explanation. First it gets the username of the person currently logged in and stores it as a variable for future use. It then determines if there is even a version of the application, or the folder which contains it, or the shortcuts even exists. If it doesn't, it creates the folder and shortcut and copies the newest front-end over, and deletes the old version and shortcuts.

I use .hta files throughout the code to let the user know stuff is happening. I use .hta because I couldn't create a MsgBox in vbScript that doesn't contain a button. The .hta's are timed to 1500ms and contain no buttons. I'll post the .hta script after the vbScript.

While there are easier ways to do all of this, this method I've found to work very well for those of us who aren't cool enough for administrator access.

This is the first bigger piece of code I've written, so please critique, offer suggestions to make things easier or simplify the code. It will be welcome providing it's constructive, of course.

My homepage VBA for the button and Form_Load() event

Button:
Code:

Private Sub cmdUpdate_Click()
On Error GoTo Err_Handler

If MsgBox("This application will now close and update" & vbCrLf & vbCrLf & "The application will restart after the update.", vbOkCancel, "New Update Available!") = vbOk Then

        DoCmd****nCommand acCmdSaveRecord        'This should be DoCmd . RunCommand (delete spaces)
        Shell "Explorer.exe ""G:\DriveHere\Database\Scripts\update.vbs"""

Application.Quit

End If

Exit_Err_Handler:
      Exit Sub
Err: Handler:
        MsgBox "Procedure: cmdUpdate_click()" & vbCrLf & "Form: Home: & _
              vbCrLf & Err.Number & vbCrLf & Err.Description & vbCrLf & _
              Err.Source, vbExclamation
End Sub

The Form_Load() event:
This portion checks to see if the label control on the home page which contains the version number matches the version number in the table Version. If it does, then no update is needed so cmdUpdate is not visible. If they don't match, then update is needed and cmdUpdate is visible.

After the update, the newest version will match the version in your backend so the button will be gone again.


Code:


Dim rs As DAO.Recordset
Dim db As Database
Dim strSQL As String

Set db = CurrentDB

strSQL = "SELECT * FROM [Version]"

Set rs = db.OpenRecordset(strSQL)

Do While Not rs.EOF

If rs!Version <> Me.lblVersion.Caption Then
    Me.cmdUpdate.visible = True
ElseIf rs!Version = Me.lblVersion.Caption Then
    Me.cmdUpdate.visible = False
End If

rs.MoveNext
Loop

Set rs = Nothing
Set db = Nothing






The vbScript: (use a text editor like, Notepad++ or Sublime and save as .vbs)

Code:


'**********************************************************************
'QID Update Script
'Version 2
'Author: Pis7ftw
'Revision: 05/11/2013
'Copyright: The following code may be used and modified providing this
'                        and the preceding comments remain intact.
'**********************************************************************

'Instructions:
'        Modifiy the file names prior to each deployment
'        Modify the paths prior to the first deployment.
'                Unless you change directories, these paths should remain constant
'        I utilized .hta files to provide status updates throughout the procedure
'                because I didn't see the need for a big update bar. Plus .hta prompts
'                are timed and and require no user intervention. Remove these if you'd like.
'        Don't forget to set the correct path for .hta's if you use them via strMsgPath
'***********************************************************************


'Begin Code

Dim objNetwork
Dim objShell

Set objNetwork = CreateObject("Wscript.Network")
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")

strDesktop = objShell.SpecialFolders("Desktop")
strUserName = objNetwork.UserName                                                                                                          'Get username of current person logged into the computer

'Current version is:
'Updated version is:
'************************************************************
'Modify the file names below prior to each update deployment
'************************************************************

strQIDFileToCopy = ""                                                                                                        'Filename of file to copy
strQIDFileToDelete = ""                                                                                                        'Filename of old version of file to delete
strQIDShortcutToDelete = ".lnk"                                                                                        'Filename of version shortcut on users desktop to delete
strQIDShortcutIconImage = ".ico"                                                                                'Name of the Shortcut image
strQIDShortcutName = ".lnk"                                                                                                'Name of the Shortcut


'************************************************************
'Modifiy the paths as needed, utilize strUserName as needed
'        if deploying across network. Make sure you terminate the
'        paths correctly (I.E. "\My Documents\" as opposed to "\My Documents")
'************************************************************

strQIDOriginPath = ""                                                                                                                                                                                                        'Origin path of the file
strQIDDestFolderPath = "C:\Documents and Settings\" & strUserName & "\My Documents\foldernamehere"                                                'Destination path for the folder to contain the application
strQIDDestAppPath = "C:\Documents and Settings\" & strUserName & "\My Documents\foldernamehere\"                                                'Destination path to the application
strQIDShortcutDestPath = "C:\Documents and Settings\" & strUserName & "\Desktop"                                                                                'Shortcut destination path
strQIDShortcutIconImagePath = ""                                                                                                                                                                                'Path to the shortcut icon image
strQIDShortcutTarget = "C:\Documents and Settings\" & strUserName & "\My Documents\foldernamehere\" & strQIDFileToCopy        'Shortcut target path'
strMsgPath = ""                                                                                                                                                                                                                        'Path to update progress messages (.hta files)

'***********************************************************
'Run the update procedures
'***********************************************************

        objShell****n strMsgPath & "updateMsg1.hta",1,True                                        'first status update message.  'should be objShell . run (delete spaces)

'Delete old shortcuts**********************************************
        If objFSO.FileExists(strQIDShortcutDestPath & strQIDShortcutToDelete) Then
                objFSO.DeleteFile(strQIDShortcutDestPath & strQIDShortcutToDelete)
        ElseIf Not objFSO.FileExists(strQIDShortcutDestPath & strQIDShortcutToDelete) Then

        End If


'Delete old version********************************************
        If objFSO.FileExists(strDestAppPath & strQIDFileToDelete) Then
                objFSO.DeleteFile(strDestAppPath & strQIDFileToDelete)
        ElseIf Not objFSO.FileExists(strDestAppPath & strQIDFileToDelete) Then

        End If



'Check to see if destination file exists.**************************
If objFSO.FolderExists(strQIDDestFolderPath) Then                                                                        'Copy the new version
        objFSO.CopyFile strQIDOriginPath & strQIDFileToCopy, strQIDDestAppPath
ElseIf Not objFSO.FolderExists(strQIDestFolderPath) Then                                                                'Create the folder and then copy the file
        objFSO.CreateFolder strQIDDestAppPath
        objFSO.CopyFile strQIDOriginPath & strQIDFileToCopy, strQIDDestAppPath
Else
        MsgBox "Unable to update the QID" & vbCrLf & vbCrLf & "Error Number: " & Err.Number & vbCrLf & vbCrLf & "Error Description: " & Err.Description & vbCrLf & "Line 74", , "Error"
End If
       

'Create new shortcut*************************************

        Set objLink = objShell.CreateShortcut(strQIDShortcutDestPath & "\" & strQIDShortcutName)
                objLink.TargetPath = strQIDShortcutTarget
                objLink.IconLocation = strQIDShortcutIconImagePath & strQIDShortcutIconImage
                objLink.Save       
        set objLink = Nothing
       


        objShell****n strMsgPath & "updateMsg2.hta",1,True                  'should be objShell . Run (delete spaces)


'Check to see if old version is still on the desktop, delete if it is.
If objFSO.FileExists(strQIDShortcutDestPath & strQIDFileToDelete) Then
        objFSO.DeleteFile(strQIDSHortcutDestPath & strQIDFileToDelete)
Else
End If

'End Code


Viewing all articles
Browse latest Browse all 13329

Trending Articles