I found this great VBScript by Bill Mosca for deploying and updateing Access DB's of all kinds. It runs great untill it gets to the line that runs the start shortcut. I am hoping someone can spot the problem.
'Launch FE.
WSHShell.Run cLOCPATH & "\" & cSCName & ".lnk"
Then errors with "System can not find the file specified.
'*******************************************************************************
' Project : Fulfillment Database (Access 2003)
'
' Title : ProjMgmt_FEUpdate.vbs
' DateTime : 10/11/2007 11:37:23
' Author : Bill Mosca
' Purpose : Installs all files needed for database application based on text
' file named ProjectMgmt_feVyyyymmdd.txt
' Index Updated on 5/21/2007)
' MakeFEShortcut - Creates/overwrites shortcut to launch
' GetDB - Copy latest files from server to local folder
' KeyExists - Checks that msAccess key exists in registry
'*******************************************************************************
Option Explicit
Const cTXTFILE = "FulfillmentDB_feVer7_2_1_3.txt"
Const cFE = "Fulfillment72.mdb"
Const cICON = "Globe.ico"
' Server Path
Const cSVRPATH = "\\appserver\Fulfillment_Database\Install"
' Local path for MDE
Const cLOCPATH = "C:\Documents and Settings\All Users\Application Data\Fulfillment_Database"
' Name of this script
Const cScriptName = "FulfillmentDB_FEUpdate_2.vbs"
' Name of animated gif used in SplashBox
Const cAniGif = "AG00174_.GIF"
Const cSCName = "StartFulfillmentDB"
'Name used for Desktop Shortcut and title of SplashBox
Const cAppName = "Fulfillment Database"
Dim WSHShell
Dim fs
Dim oIE
'*******************************************************************************
Function SplashBox(sTitle)
'*******************************************************************************
'Purpose : Creates Splash screen while front end downloads.
'DateTime : 1/11/2007 11:18
'Author : Tom Lavedas
Dim s, sBody, item
Set oIE = CreateObject("InternetExplorer.Application")
With oIE
'Commented out for IE7
'.FullScreen = True
.Toolbar = False
.RegisterAsDropTarget = False
.StatusBar = False
.Menubar = False
.Addressbar = False
.Navigate ("about:blank")
Do Until .ReadyState = 4: WScript.Sleep 100: Loop
.Width = 300: .Height = 300
With .Document
With .ParentWindow.Screen
oIE.Left = (.availWidth - oIE.Width) \ 2
oIE.Top = (.availheight - oIE.Height) \ 2
End With
sBody = "Please wait while latest version of " & cAppName & " loads..."
s = "<html><head><title>" & sTitle _
& "</title></head><script language=vbs>bWait=true<" & "/script>" _
& "<body bgColor=#0d8499><center>" _
& "<center> </center>" _
& "<center> </center>" _
& "<center>" _
& "<font face=" & Chr(34) & "Comic Sans MS" & Chr(34) & " color=#d4d4d4>" _
& sBody & "</font><p>" _
& "<img alt=" & Chr(34) & Chr(34) _
& "src=" & Chr(34) & "file:///" & cSVRPATH & "\" & cAniGif & Chr(34) _
& "align=bottom>"
s = s & "<br><br> <input id=Button1 type=button value=Cancel onclick =Window.Close()>"
s = s & "</center></body></html>"
.Open
.Write (s)
.Close
Do Until .ReadyState = "complete": WScript.Sleep 50: Loop
With .body
.Scroll = "no"
.Style.BorderStyle = "outset"
.Style.BorderWidth = "3px"
End With
oIE.Visible = True
CreateObject("Wscript.Shell").AppActivate sTitle
On Error Resume Next
On Error GoTo 0
End With
End With
End Function
'*******************************************************************************
Public Function MakeFEShortcut()
'*******************************************************************************
'Purpose : Creates/overwrites shortcut to launch
' front end.
Dim Shortcut, DesktopPath, StartupPath
Dim MSAccPath
On Error Resume Next
'Kill shortcut so icon will be default Access icon.
If fs.FileExists(cLOCPATH & "\" & cSCName & ".lnk") Then
fs.DeleteFile cLOCPATH & "\" & cSCName & ".lnk", True
End If
'Create shortcut in same folder as FE.
Set Shortcut = WSHShell.CreateShortcut(cLOCPATH & "\" & cSCName & ".lnk")
'Get msaccess path
MSAccPath = WSHShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\" _
& "CurrentVersion\App Paths\MSACCESS.EXE\Path")
If Err <> 0 Then
MsgBox "MS Access is not installed. Installation aborted."
Set Shortcut = Nothing
Err = 0
Exit Function
End If
Shortcut.TargetPath = """" & MSAccPath & "\msaccess.exe" & """"
Shortcut.arguments = """" & cLOCPATH & "\" & cFE & """"
StartupPath = MSAccPath
If fs.FolderExists(StartupPath) Then
Shortcut.WorkingDirectory = StartupPath
End If
Shortcut.Description = "Application"
'Commented out. Use default Access Icon for this shortcut.
'Shortcut.IconLocation = cLOCPATH & "\" & cICON
Shortcut.Save
Set Shortcut = Nothing
MakeFEShortcut = True
End Function
'*******************************************************************************
Sub GetDB()
'*******************************************************************************
'Purpose : Copy latest files from server to local folder
If Not fs.FolderExists(cLOCPATH) Then
fs.CreateFolder (cLOCPATH)
End If
fs.CopyFile cSVRPATH & "\" & cTXTFILE, cLOCPATH & "\", True
If Err.Number <> 0 Then
MsgBox Err.number & "-" & err.Description
End If
fs.CopyFile cSVRPATH & "\" & cFE, cLOCPATH & "\", True
If Err.Number <> 0 Then
MsgBox Err.number & "-" & err.Description
End If
fs.CopyFile cSVRPATH & "\" & cICON, cLOCPATH & "\", True
If Err.Number <> 0 Then
MsgBox Err.number & "-" & err.Description
End If
End Sub
'*******************************************************************************
Public Function MakeDesktopShortcut(sName, target)
'*******************************************************************************
'Purpose : Create new desktop shortcut in case something has changed.
Dim Shortcut, DesktopPath, StartupPath
DesktopPath = WSHShell.SpecialFolders("Desktop")
Set Shortcut = WSHShell.CreateShortcut(DesktopPath & "\" & sName & ".lnk")
Shortcut.TargetPath = target
StartupPath = fs.GetParentFolderName(target)
If fs.FolderExists(StartupPath) Then
Shortcut.WorkingDirectory = StartupPath
End If
Shortcut.IconLocation = cLOCPATH & "\" & cICON
Shortcut.Save
End Function
'*******************************************************************************
Sub main()
'*******************************************************************************
'Splash screen to let user know something is going on.
Call SplashBox(cAppName)
Set WSHShell = WScript.CreateObject("WScript.Shell")
Set fs = WScript.CreateObject("Scripting.FileSystemObject")
'See if latest text file is in local folder. Also check if FE is missing.
If fs.FileExists(cLOCPATH & "\" & cTXTFILE) = False _
Or fs.FileExists(cLOCPATH & "\" & cFE) = False Then
On Error Resume Next
fs.DeleteFile(cLOCPATH & "\" & "FulfillmentDB_feVer*.txt")
Err.clear
Call GetDB
End If
If Err.Number <> 0 Then
MsgBox Err.number & "-" & err.Description
Else
'Just in case we need a new FE shortcut...
If MakeFEShortcut = False Then
Set fs = Nothing
Set WSHShell = Nothing
WSCRIPT.QUIT(0)
Exit Sub
End If
MakeDesktopShortcut cAppName, cSVRPATH & "\" & cScriptName
'Occasionally MSAccess opens before filecopy is finished.
WScript.Sleep 5000
'Launch FE.
WSHShell.Run cLOCPATH & "\" & cSCName & ".lnk"
End If
oIE.Quit
set oIE = Nothing
Set fs = Nothing
Set WSHShell = Nothing
WSCRIPT.QUIT(0)
End Sub
'*******************************************************************************
'VBScript Starting point
Call main
'*******************************************************************************
'Launch FE.
WSHShell.Run cLOCPATH & "\" & cSCName & ".lnk"
Then errors with "System can not find the file specified.
'*******************************************************************************
' Project : Fulfillment Database (Access 2003)
'
' Title : ProjMgmt_FEUpdate.vbs
' DateTime : 10/11/2007 11:37:23
' Author : Bill Mosca
' Purpose : Installs all files needed for database application based on text
' file named ProjectMgmt_feVyyyymmdd.txt
' Index Updated on 5/21/2007)
' MakeFEShortcut - Creates/overwrites shortcut to launch
' GetDB - Copy latest files from server to local folder
' KeyExists - Checks that msAccess key exists in registry
'*******************************************************************************
Option Explicit
Const cTXTFILE = "FulfillmentDB_feVer7_2_1_3.txt"
Const cFE = "Fulfillment72.mdb"
Const cICON = "Globe.ico"
' Server Path
Const cSVRPATH = "\\appserver\Fulfillment_Database\Install"
' Local path for MDE
Const cLOCPATH = "C:\Documents and Settings\All Users\Application Data\Fulfillment_Database"
' Name of this script
Const cScriptName = "FulfillmentDB_FEUpdate_2.vbs"
' Name of animated gif used in SplashBox
Const cAniGif = "AG00174_.GIF"
Const cSCName = "StartFulfillmentDB"
'Name used for Desktop Shortcut and title of SplashBox
Const cAppName = "Fulfillment Database"
Dim WSHShell
Dim fs
Dim oIE
'*******************************************************************************
Function SplashBox(sTitle)
'*******************************************************************************
'Purpose : Creates Splash screen while front end downloads.
'DateTime : 1/11/2007 11:18
'Author : Tom Lavedas
Dim s, sBody, item
Set oIE = CreateObject("InternetExplorer.Application")
With oIE
'Commented out for IE7
'.FullScreen = True
.Toolbar = False
.RegisterAsDropTarget = False
.StatusBar = False
.Menubar = False
.Addressbar = False
.Navigate ("about:blank")
Do Until .ReadyState = 4: WScript.Sleep 100: Loop
.Width = 300: .Height = 300
With .Document
With .ParentWindow.Screen
oIE.Left = (.availWidth - oIE.Width) \ 2
oIE.Top = (.availheight - oIE.Height) \ 2
End With
sBody = "Please wait while latest version of " & cAppName & " loads..."
s = "<html><head><title>" & sTitle _
& "</title></head><script language=vbs>bWait=true<" & "/script>" _
& "<body bgColor=#0d8499><center>" _
& "<center> </center>" _
& "<center> </center>" _
& "<center>" _
& "<font face=" & Chr(34) & "Comic Sans MS" & Chr(34) & " color=#d4d4d4>" _
& sBody & "</font><p>" _
& "<img alt=" & Chr(34) & Chr(34) _
& "src=" & Chr(34) & "file:///" & cSVRPATH & "\" & cAniGif & Chr(34) _
& "align=bottom>"
s = s & "<br><br> <input id=Button1 type=button value=Cancel onclick =Window.Close()>"
s = s & "</center></body></html>"
.Open
.Write (s)
.Close
Do Until .ReadyState = "complete": WScript.Sleep 50: Loop
With .body
.Scroll = "no"
.Style.BorderStyle = "outset"
.Style.BorderWidth = "3px"
End With
oIE.Visible = True
CreateObject("Wscript.Shell").AppActivate sTitle
On Error Resume Next
On Error GoTo 0
End With
End With
End Function
'*******************************************************************************
Public Function MakeFEShortcut()
'*******************************************************************************
'Purpose : Creates/overwrites shortcut to launch
' front end.
Dim Shortcut, DesktopPath, StartupPath
Dim MSAccPath
On Error Resume Next
'Kill shortcut so icon will be default Access icon.
If fs.FileExists(cLOCPATH & "\" & cSCName & ".lnk") Then
fs.DeleteFile cLOCPATH & "\" & cSCName & ".lnk", True
End If
'Create shortcut in same folder as FE.
Set Shortcut = WSHShell.CreateShortcut(cLOCPATH & "\" & cSCName & ".lnk")
'Get msaccess path
MSAccPath = WSHShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\" _
& "CurrentVersion\App Paths\MSACCESS.EXE\Path")
If Err <> 0 Then
MsgBox "MS Access is not installed. Installation aborted."
Set Shortcut = Nothing
Err = 0
Exit Function
End If
Shortcut.TargetPath = """" & MSAccPath & "\msaccess.exe" & """"
Shortcut.arguments = """" & cLOCPATH & "\" & cFE & """"
StartupPath = MSAccPath
If fs.FolderExists(StartupPath) Then
Shortcut.WorkingDirectory = StartupPath
End If
Shortcut.Description = "Application"
'Commented out. Use default Access Icon for this shortcut.
'Shortcut.IconLocation = cLOCPATH & "\" & cICON
Shortcut.Save
Set Shortcut = Nothing
MakeFEShortcut = True
End Function
'*******************************************************************************
Sub GetDB()
'*******************************************************************************
'Purpose : Copy latest files from server to local folder
If Not fs.FolderExists(cLOCPATH) Then
fs.CreateFolder (cLOCPATH)
End If
fs.CopyFile cSVRPATH & "\" & cTXTFILE, cLOCPATH & "\", True
If Err.Number <> 0 Then
MsgBox Err.number & "-" & err.Description
End If
fs.CopyFile cSVRPATH & "\" & cFE, cLOCPATH & "\", True
If Err.Number <> 0 Then
MsgBox Err.number & "-" & err.Description
End If
fs.CopyFile cSVRPATH & "\" & cICON, cLOCPATH & "\", True
If Err.Number <> 0 Then
MsgBox Err.number & "-" & err.Description
End If
End Sub
'*******************************************************************************
Public Function MakeDesktopShortcut(sName, target)
'*******************************************************************************
'Purpose : Create new desktop shortcut in case something has changed.
Dim Shortcut, DesktopPath, StartupPath
DesktopPath = WSHShell.SpecialFolders("Desktop")
Set Shortcut = WSHShell.CreateShortcut(DesktopPath & "\" & sName & ".lnk")
Shortcut.TargetPath = target
StartupPath = fs.GetParentFolderName(target)
If fs.FolderExists(StartupPath) Then
Shortcut.WorkingDirectory = StartupPath
End If
Shortcut.IconLocation = cLOCPATH & "\" & cICON
Shortcut.Save
End Function
'*******************************************************************************
Sub main()
'*******************************************************************************
'Splash screen to let user know something is going on.
Call SplashBox(cAppName)
Set WSHShell = WScript.CreateObject("WScript.Shell")
Set fs = WScript.CreateObject("Scripting.FileSystemObject")
'See if latest text file is in local folder. Also check if FE is missing.
If fs.FileExists(cLOCPATH & "\" & cTXTFILE) = False _
Or fs.FileExists(cLOCPATH & "\" & cFE) = False Then
On Error Resume Next
fs.DeleteFile(cLOCPATH & "\" & "FulfillmentDB_feVer*.txt")
Err.clear
Call GetDB
End If
If Err.Number <> 0 Then
MsgBox Err.number & "-" & err.Description
Else
'Just in case we need a new FE shortcut...
If MakeFEShortcut = False Then
Set fs = Nothing
Set WSHShell = Nothing
WSCRIPT.QUIT(0)
Exit Sub
End If
MakeDesktopShortcut cAppName, cSVRPATH & "\" & cScriptName
'Occasionally MSAccess opens before filecopy is finished.
WScript.Sleep 5000
'Launch FE.
WSHShell.Run cLOCPATH & "\" & cSCName & ".lnk"
End If
oIE.Quit
set oIE = Nothing
Set fs = Nothing
Set WSHShell = Nothing
WSCRIPT.QUIT(0)
End Sub
'*******************************************************************************
'VBScript Starting point
Call main
'*******************************************************************************