Option Explicit
Const OverwriteExisting = True
Dim WshNetwork
Dim strUser
Set WshNetwork = WScript.CreateObject("WScript.Network")
strUser = WshNetwork.UserName
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
'WScript.Echo GetOSArchitecture()
Dim strAccessVBOM
Dim strVBAWarnings
Dim strUFIControls
Dim strArchitecture
strArchitecture = GetOSArchitecture()
Dim Application_Version
Application_Version = "14.0"
strAccessVBOM = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Application_Version & "\Access\Security\AccessVBOM"
strVBAWarnings = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Application_Version & "\Access\Security\VBAWarnings"
strUFIControls= "HKEY_CURRENT_USER\Software\Microsoft\Office\Common\Security\UFIControls"
' WScript.echo strAccessVBOM
' WScript.echo strVBAWarnings
' WScript.echo strUFIControls
WshShell.RegWrite strAccessVBOM, 1, "REG_DWORD"
WshShell.RegWrite strVBAWarnings, 1, "REG_DWORD"
WshShell.RegWrite strUFIControls, 1, "REG_DWORD"
' arrValues = objShell.RegRead _
' ("HKLM\SOFTWARE\ODBC\ODBCINST.INI")
' For Each strValue In arrValues
' If strValue = "SQL Server Native Client 10.0" Then
' 'Skip Install
' Else
' Run "sqlncli" & ".msi" & "/passive /norestart"
' Next
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFile "myAccessApp.accdb" , _
"myAccessApp.accdb" & strUser & ".accdb", OverwriteExisting
Run "myAccessApp.accdb" & strUser & ".accdb"
objfso.DeleteFile "myAccessApp.accdb" & strUser & ".accdb"
WScript.Quit 1
'-----------------------------------------------------------------------------
'-----------------------------------------------------------------------------
'-----------------------------------------------------------------------------
Sub Run(ByVal sFile)
Dim shell
Set shell = CreateObject("WScript.Shell")
shell.Run Chr(34) & sFile & Chr(34) & "/nostartup", 1, True
Set shell = Nothing
End Sub
'-----------------------------------------------------------------------------
'-----------------------------------------------------------------------------
Function GetOSArchitecture()
Dim objWMIservice
Dim colItems
Dim objItem
Dim strWQL
Dim strArchitecture
Dim strComputer
strWQL = "SELECT * FROM Win32_OperatingSystem"
strComputer = "."
Set objWMIservice = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIservice.ExecQuery(strWQL, , 48)
For Each objItem In colItems
If Left(objItem.Version,1) > 5 Then
strArchitecture = objItem.OSArchitecture
Else
strArchitecture = Null
End If
Next
GetOSArchitecture = strArchitecture
Set objItem = Nothing
Set colItems = Nothing
Set objWMIservice = Nothing
End Function
'-----------------------------------------------------------------------------
'-----------------------------------------------------------------------------
Function GetOSVersion()
Dim objWMIservice
Dim colItems
Dim objItem
Dim strWQL
Dim strVersion
strWQL = "SELECT * FROM Win32_OperatingSystem"
strComputer = "."
Set objWMIservice = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIservice.ExecQuery(strWQL, , 48)
For Each objItem In colItems
strVersion = objItem.Version
Next
GetOSVersion = strVersion
Set objItem = Nothing
Set colItems = Nothing
Set objWMIservice = Nothing
End Function