possible to combine Ken Higg's FE version control WITH DCrake's shell extension code?

[DCrake]

Have not been following this post much, very busy. Anyway, in a nutshell what is the final outcome? and what does it do?

David

 

[wiklendt]

Have not been following this post much, very busy. Anyway, in a nutshell what is the final outcome? and what does it do?

David

been using Ken Higg's Front End loader example to update my FE in a server situation. The loader would check version on Master FE and Client FE. If different, would copy Master FE over Client FE, then open the Client FE.

In order to open the Client FE, Ken's code used the absolute path of the MS Access exe (which Ken had hard-coded) in a Shell command. the issue arose where a different absolute path is used for access 2007 (that i was using for development and testing) than previous versions (that the 'client' would be using), and this could possibly change again in future versions.

To get around this, i determined the full path to the executable using a native Access command acSysCmdAccessDir, so it will work on any version of access, in any installation path the client has (and fingers crossed MS never change their exe name!):

Dim cstrMSAccessAPP As String   'Folder path of Access Executable
cstrMSAccessAPP = SysCmd(acSysCmdAccessDir) & "MSAccess.exe"

(is that too verbose?)

 

[KenHigg]

Thanks for the update Wik.

So the command line token thing still works in 2007?

 

[wiklendt]

Thanks for the update Wik.

So the command line token thing still works in 2007?

i didn't actually check that b/c i removed that check from the FE when i was having trouble earlier with the code, and haven't put it back in since (as i don't really need/want it).

however, your very original code DOES work with the token in 2007, and with my tweak i haven't removed the reference for it in the command line and the loader still copies new FE and loads it (just doesn't check for token b/c it's not there in the FE)

i'll go back and see if i can get it to work with the token in the tweaked code. i would presume so, since the command line was not changed at all, only the way i got the value of for "cstrMSAccessAPP".

 

[wiklendt]

yup - token works a treat (Vista, Ac2007, acSysCmdAccessDir), Ken

that was easy, and you know, i might just keep it with the token - why not, eh?

 

[wiklendt]

one last thing - in the subCopyMasterOver, i've added a brief snippet of code for access to create the expected folder path of the client FE if one doesn't exist already (which is fine for my situation where i've standardised my Client FE location):

    ' If the expected folder structure on client machine does not exist, create it.
    If Dir(cstrClientFEPath) = "" Then
        MkDir (cstrClientFEPath)
    End If

i've checked this on my local machine and it works (creates directory and then copies FE over in a seemless way), just need to make sure it's fine for the shared network setup (i don't expect problems, but better fore-warned!)

 

[KenHigg]

Cool -

I have to be carefull with token thing and a 'disable shift' that I always deploy a copy. I have locked myself completly out

 

[wiklendt]

Cool -

I have to be carefull with token thing and a 'disable shift' that I always deploy a copy. I have locked myself completly out

LOL, oops!

i don't disable shift in my DB's (so far/yet)... but will have to remember the risks if i start to!

 

[DCrake]

When you have finished it would be nice if you could drop it into a sample mdb to test in different environments. You never know this may superseed BL's version.

David

 

[wiklendt]

When you have finished it would be nice if you could drop it into a sample mdb to test in different environments. You never know this may superseed BL's version.

David

sure i can do that.

as a last feature add-on to this FE updating system, i'm working on a way to copy a shortcut file onto all user's desktop (on a button click at the moment until i get the code right).

i'm having a little issue where access supposedly can't find the file when i link to the path... it's not a shortcut extension problem, i don't think, b/c i tried copying a regular xlsx file and it didn't like that either.

i got the full path by selecting "copy address as text", so i know it's right, and i even copied the file name rather than typing it out, so i know that's right too.

(edit: i don't think it's a "special path" thing either b/c a message box returned the correct (expected) string "C:\Users\Public\Desktop" (correct for Vista))

it's giving me an error:

Runtime error 75: Path/File access error

and highlights my FileCopy line:

Option Compare Database

Private Sub cmdCopyShortcut_Click()
On Error GoTo Err_cmdCopyShortcut_Click

' SPECIAL FOLDERS -------------------------------------------------------
' http://www.rondebruin.nl/folder.htm
'
'FOR ALL USERS:
' AllUsersDesktop, AllUsersStartMenu, AllUsersPrograms, AllUsersStartup
'
'FOR CURRENT USER:
' Desktop, Favorites, Fonts, MyDocuments, NetHood, PrintHood, Programs,
' Recent, SendTo, StartMenu, Startup, Templates
' -----------------------------------------------------------------------

'Get Special folder
    Dim objWshShell As Object
    Dim strSpecialPath As String
    Dim strCopyPath As String

    Set objWshShell = CreateObject("WScript.Shell")
    strSpecialPath = objWshShell.SpecialFolders("AllUsersDesktop")
    
    strCopyPath = "C:\Users\Agnieszka\Documents\Database Work\RLS Orders.lnk"
    
    FileCopy strCopyPath, strSpecialPath
    
    'MsgBox strSpecialPath
    'Open folder in Explorer
    'Shell "explorer.exe " & strSpecialPath, vbNormalFocus

Exit_cmdCopyShortcut_Click:
    Exit Sub

Err_cmdCopyShortcut_Click:

    Msg = "Error # " & Str(Err.Number) & Chr(13) & " (" & Err.Description & ")"
    Msg = Msg & Chr(13) & "in Form_frmSpecialFolders | cmdCopyShortcut_Click"
    MsgBox Msg, vbOKOnly, "Database1", Err.HelpFile, Err.HelpContext
    Resume Exit_cmdCopyShortcut_Click

End Sub

i've just come online now to investigate... but any pointers on the issue are welcome.

 

[wiklendt]

huh - Villarreal68 just posted this, but when i came to the thread the post was not there? (it was written in my email notification) anyway, thanks for the tip, i'll look into that René

Just a thought about copying *.lnk files. When ever I have to remotely roll out *.lnk files with a script, I notice that the *.lnk file will not copy for some reason. So what I usually do is change the extension of the file to *.txt and then copy it and once copied I rename it to a *.lnk file and it always works that way.

So I wonder if this is somewhat similar. just my .02 cents.

René

 

[Villarreal68]

Sorry to have confused you. When I re-read your comment and found the following quoted text:

it's not a shortcut extension problem, i don't think, b/c i tried copying a regular xlsx file and it didn't like that either.

I realized I may have just reiterated what you had already stated. So I deleted the post right away thiking that maybe noone had seen it already...notthinking that you would have received an email instantly.

René

 

[wiklendt]

Sorry to have confused you. When I re-read your comment and found the following quoted text:



I realized I may have just reiterated what you had already stated. So I deleted the post right away thiking that maybe noone had seen it already...notthinking that you would have received an email instantly.

René

even with that info in mind, i still tried your method - it did not help. what is interesting, is that if i manually change the name of the shortcut without appropriately changing the path/name in the code, the error message i get changes from "path/file access error (75)" to "file not found error (53)" - which makes me think that perhaps it's a windows permissions/admin thing? i checked, and the file is neither hidden nor read-only.

also, access help states that one possibility for error 53 might be a missing reference, but i checked my references and none were flagged as missing.

...and i have NO idea how to tackle a permission/windows issue - what's more is that i can make/move/copy the shortcut manually without issue or error through windows explorer. it may just be one of those things that comes with more expertise - for now it was just a bell/whistle, so i feel i can let it go until my epiphany comes (read: find the right website through google with the code written out nicely for me! ;P)

 

[wiklendt]

hmmm... i just had a look at the folders.... the SHORTCUT FILE might not be hidden, but the desktop folder is... so now i just need to find out how to copy to a hidden folder...? why that should make a difference i don't know...

however, i can't even use the code to copy to my user desktop...

*sigh* MS just likes making things difficult, doesn't it...

 

[DCrake]

Wik,

Here is a module that asks the user if they want to create a shortcut on theor machine if it not present. This might work for you.

Option Compare Database
Option Explicit

Function CreateDatabaseShortcut(Optional Location = "Desktop")
On Error GoTo CreateDatabaseShortcut_error

'Makes a shortcut to this database file in Location
'Location options are "Desktop","AllUsersDesktop","Favorites","StartMenu","AllUsersStartMenu","Startup","AllUsersStartup"

Dim shell, Path, link, Msg, r

Select Case Location
   Case "Desktop"
      Msg = "Create a shortcut to the database on your desktop?"
   Case "AllUsersDesktop"
      Msg = "Create a shortcut to the database on the desktop for all users of this machine?"
   Case "Favorites"
      Msg = "Create a shortcut to the database in your list of favourites?"
   Case "StartMenu"
      Msg = "Create a shortcut to the database in your Start All Programs Menu?"
   Case "AllUsersStartMenu"
      Msg = "Create a shortcut to the database on the Start All Programs Menu for all users of this machine?"
   Case "Startup"
      Msg = "Create a shortcut to the database in your Startup folder?"
      Msg = Msg & vbNewLine & "The database will open automatically every time you start this machine."
   Case "AllUsersStartup"
      Msg = "Create a shortcut to the database in the Startup folder for all users of this machine?"
      Msg = Msg & vbNewLine & "The database will open automatically every time this machine is started."
   Case Else
      MsgBox "Not a valid shortcut to the database location: " & Location, vbExclamation + vbOKOnly, "Error in CreateDatabaseshortcut to the database"
      GoTo CreateDatabaseShortcut_Exit
End Select

r = MsgBox(Msg, vbQuestion + vbYesNo, "Confirm")
If r = vbNo Then GoTo CreateDatabaseShortcut_Exit

Set shell = CreateObject("WScript.shell")
Path = shell.SpecialFolders(Location)
Set link = shell.CreateShortcut(Path & "\" & DMin("[ApplicationFullTitle]", "[[COLOR="Red"]tblSystemCode[/COLOR]]") & ".lnk")

link.Description = DMin("[ApplicationFullTitle]", "[[COLOR="red"]tblSystemCode[/COLOR]]") & vbNewLine & [COLOR="red"]"from www.YourWebAddressHere(Optional)"[/COLOR]
link.TargetPath = GetCurrentDBpath
link.WindowStyle = 3
link.WorkingDirectory = GetCurrentDBpath(False, False)
link.Save

Msg = Replace(Msg, "Create a Shortcut to the database", "A shortcut to the database has been created")
Msg = Replace(Msg, "?", ".")
MsgBox Msg, vbOKOnly + vbInformation, "Shortcut Created"
   
CreateDatabaseShortcut_Exit:
On Error Resume Next
Set shell = Nothing
Exit Function

CreateDatabaseShortcut_error:
Select Case Err
   Case Else
      MsgBox Err & "-" & Error$, vbCritical + vbOKOnly, "Error in module CreateDatabaseShortcut"
      Resume CreateDatabaseShortcut_Exit
End Select
End Function

Function MakeShortcut()
On Error GoTo MakeShortcut_error

   Dim s As String
   Dim r As Long
   Dim Rs As Recordset
 [COLOR="red"]  Set Rs = CurrentDb.OpenRecordset("SELECT * FROM [Tbl-Users] WHERE UserID = """ & GetUserID() & """", dbOpenDynaset)[/COLOR]
   If Not Nz(Rs![UserShortcut], False) Then
      s = "Would you like me to create a shortcut to this database on"
      s = s & vbNewLine
      s = s & "your desktop so that you can find it again later?"
      r = MsgBox(s, vbYesNo + vbQuestion, "Make Shortcut?")
      If r = vbYes Then
         CreateDatabaseShortcut
      End If
      Rs.Edit
      Rs![UserShortcut] = True
      Rs.Update
   End If

MakeShortcut_Exit:
On Error Resume Next
Rs.Close
Set Rs = Nothing
Exit Function

MakeShortcut_error:
Select Case Err
   Case Else
      MsgBox Err & "-" & Error$, vbCritical + vbOKOnly, "Error in module MakeShortcut"
      Resume MakeShortcut_Exit
End Select
End Function

I have highlighted some code that works with a table in the mdb that checks if they already have one or not. The tblsystemcode records info about the system itself, but should be self explanitory.

David

 

[wiklendt]

Wik,

Here is a module that asks the user if they want to create a shortcut on theor machine if it not present. This might work for you.

wow, thanks for that David that looks like a sophisticated system!

i'm glad to report a had my epiphany! the problem was that the destination path MUST include the file name also - even if it doesn't exist yet.

might help to think about it more like "my file before copy" and "my file after copy" rather than "i want my file in this folder"...

i will start working on that sample db my aim is to create a sort of "template" for a split networked updatable system for noobs

 

[dbDamo]

I was unable to copy a shortcut to a users Desktop through Access because of permissions so I ended up creating a .bat file to do it and ran that file from Access using a Shell command. Not pretty but it does the job...

 

[wiklendt]

ok, here is what i've managed to do with the shortcut.

a form with a combo to select location of shortcut.
a textbox displaying the name of the VBAproject (locked).
two buttons - "create" and "remove"

(edit: i decided against saving existing user shortcuts in a table b/c i thought that was too complex for my project and don't really think it's necessary. to compensate, i added the "remove" command button)

combobox i've used a value list as row source (so the form can be "standalone") with three columns setup like (all one line, but formatted for readability):

    '1;"All Users - Desktop";"AllUsersDesktop";
    '2;"All Users - Start Menu";"AllUsersStartMenu";
    '3;"All Users - Startup *";"AllUsersStartup";
    '4;"Single User - Desktop";"Desktop";
    '5;"Single User - Start Menu";"StartMenu";
    '6;"Single User - Startup *";"Startup";
    '7;"Single User - My Documents";"MyDocuments"

column 1 (integers) is to make the coding easier
column 2 (long desc) is for the user to see
column 3 (short desc) is what the shell object requires to determine path.

there are more than 7 'special' folders, but these are the only ones i want to use in my current app. this is the full list as i understand it to be.

here is the code from the form module. i think i can be made more elegant, as i have repeated some code to make the buttons work, but it does the job for now

on form open:

Private Sub Form_Open(Cancel As Integer)
On Error GoTo Err_Form_Open

    ' VB Project Name can be set by code using
    ' Application.VBE.VBProjects("VBAProject").Name = NewName
    ' OR
    ' via Tools | <projectname> Properties... in VB Editor (VBE)
    
    ' get the VBE project name and use it as the ShortcutName

    Me.txtShortcutName.Value = Application.VBE.ActiveVBProject.Name

Exit_Form_Open:
    Exit Sub

Err_Form_Open:
    Msg = "Error # " & Str(Err.Number) & Chr(13) & " (" & Err.Description & ")"
    Msg = Msg & Chr(13) & "in Form_frmSettings | Form_Open"
    MsgBox Msg, vbMsgBoxHelpButton, "RLS Orders", Err.HelpFile, Err.HelpContext
    Resume Exit_Form_Open

End Sub

on click of button "create"

Private Sub cmdShortcutCreate_Click()
On Error GoTo Err_cmdShortcutCreate_Click

    Dim objShell As Object
    Dim strPath As String
    Dim strTargetPath As String
    Dim strTarget As String
    Dim Msg As String
    Dim link
    
    Select Case Me.cmbShortcutLocation.Column(0)
        Case 1, 2, 3, 4, 5, 6, 7 'valid selections, continue with code
        Case Else 'invalid selection, get user to chose from combo
            MsgBox "Invalid Shortcut Location." & Chr(13) _
                    & "Please select a location from the dropdown.", _
                    vbExclamation + vbOKOnly, "RLS Orders Error"
            Me.cmbShortcutLocation.SetFocus
            GoTo Exit_cmdShortcutCreate_Click
    End Select
        
    strTargetPath = fHTC_GetBEFolder("tblOrders")
    strTargetFile = strTargetPath & "\ORDERS_ReferenceLabs.mdb"

    Set objShell = CreateObject("WScript.shell")
    strPath = objShell.SpecialFolders(Me.cmbShortcutLocation.Column(2))
    
    '--------------------------------------------------------------------------------
    ' shortcut creation code adapted from DCrake (AWF)
    ' http://www.access-programmers.co.uk/forums/
    Set link = objShell.CreateShortcut(strPath & "\" & Me.txtShortcutName & ".lnk")
    link.Description = "Record and track orders for Reference Section Labs"
    link.TargetPath = strTargetFile
    link.WindowStyle = 3
    link.WorkingDirectory = strTargetPath
    link.HotKey = "CTRL+SHIFT+O" '"O" for "Orders"
    link.Save
    '--------------------------------------------------------------------------------

    MsgBox "Shortchut created successfully for:" & Chr(13) & Chr(13) _
            & Me.cmbShortcutLocation.Column(1) & Chr(13) & Chr(13) _
            & "(" & strPath & ")", vbInformation + vbOKOnly, "RLS Orders"
    
Exit_cmdShortcutCreate_Click:
    Exit Sub

Err_cmdShortcutCreate_Click:
    Msg = "Error # " & Str(Err.Number) & Chr(13) & " (" & Err.Description & ")"
    Msg = Msg & Chr(13) & "in Form_frmSettings | cmdCreateShortcut_Click"
    MsgBox Msg, vbMsgBoxHelpButton, "RLS Orders", Err.HelpFile, Err.HelpContext
    Resume Exit_cmdShortcutCreate_Click

End Sub

on click of button "remove"

Private Sub cmdShortcutRemove_Click()
On Error GoTo Err_cmdShortcutRemove_Click
    
    Dim objShell As Object
    Dim strPath As String
    Dim Msg As String

    Select Case Me.cmbShortcutLocation.Column(0)
        Case 1, 2, 3, 4, 5, 6, 7 'valid selections, continue with code
        Case Else 'invalid selection, get user to chose from combo
            MsgBox "Invalid Shortcut Location." & Chr(13) _
                    & "Please select a location from the dropdown.", _
                    vbExclamation + vbOKOnly, "RLS Orders Error"
            Me.cmbShortcutLocation.SetFocus
            GoTo Exit_cmdShortcutRemove_Click
    End Select
        
    Set objShell = CreateObject("WScript.shell")
    strPath = objShell.SpecialFolders(Me.cmbShortcutLocation.Column(2)) & "\" & Me.txtShortcutName & ".lnk"
    Kill strPath
    
    MsgBox "Shortcut removed for: " & Chr(13) & Chr(13) _
            & Me.cmbShortcutLocation.Column(1), _
            vbInformation + vbOKOnly, "RLS Orders"

Exit_cmdShortcutRemove_Click:
    Exit Sub

Err_cmdShortcutRemove_Click:
    Msg = "Error # " & Str(Err.Number) & Chr(13) & " (" & Err.Description & ")"
    Msg = Msg & Chr(13) & "in Form_frmSettings | cmdShortcutRemove_Click"
    MsgBox Msg, vbMsgBoxHelpButton, "RLS Orders", Err.HelpFile, Err.HelpContext
    Resume Exit_cmdShortcutRemove_Click

End Sub

 

[wiklendt]

i can now start working on a sample DB with what we've discussed in this thread

 

[KenHigg]

Cool - Could you document/explain all the mods/enhancements you've made in a post in the sample database section? And maybe include a sample .mdb?