Change Access server connection from command line - ms-access

I have inherited an Access 2007 ADP application that uses a SQL Server 2008 backend. Is it possible to change the server connection used by the application from the command line or by some VBScript? At the moment, when I am releasing the application to a test/UAT/production environment, I have to open the project, change the server connection, and save it again.
I am trying to automate the build process as much as possible, and currently this is one of the last remaining manual tasks.

Hmm, my Google-fu is weak. I just found an article on MSDN which gives the VBA script to achieve this. I modified it to run as a VBScript below:
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
If (WScript.Arguments.Count = 0) Then
WScript.Echo "ERROR - the Access project name must be specified"
WScript.Quit()
End If
Dim sAccessProject
sAccessProject = fso.GetAbsolutePathName(WScript.Arguments(0))
If (fso.FileExists(sAccessProject) = False) Then
WScript.Echo "ERROR - the Access project could not be located : " & sAccessProject
WScript.Quit()
End If
If (WScript.Arguments.Count = 1) Then
WScript.Echo "ERROR - the SQL Server hostname must be specified"
WScript.Quit()
End If
Dim sServer
sServer = WScript.Arguments(1)
If (WScript.Arguments.Count = 2) Then
WScript.Echo "ERROR - the SQL Server database name must be specified"
WScript.Quit()
End If
Dim sDatabase
sDatabase = WScript.Arguments(2)
Dim sUsername
If (WScript.Arguments.Count = 3) Then
sUsername = ""
Else
sUsername = WScript.Arguments(3)
End If
Dim sPassword
If (WScript.Arguments.Count >= 3) Then
sPassword = ""
Else
sPassword = WScript.Arguments(4)
End If
ChangeADPConnection sAccessProject, sServer, sDatabase, sUsername, sPassword
Function ChangeADPConnection(strProjectName, strServerName, strDBName, strUN , strPW)
Dim strConnect
Dim oApplication
Set oApplication = CreateObject("Access.Application")
WScript.Echo "Starting MS Access"
WScript.Echo "Opening " & strProjectName & " ..."
oApplication.OpenAccessProject strProjectName
oApplication.Visible = false
oApplication.CurrentProject.CloseConnection
'The Provider, Data Source, and Initial Catalog arguments are required.
strConnect = "Provider=SQLOLEDB.1" & _
";Data Source=" & strServerName & _
";Initial Catalog=" & strDBName
If strUN <> "" Then
strConnect = strConnect & ";User ID=" & strUN
If strPW <> "" Then
strConnect = strConnect & ";Password=" & strPW
End If
Else 'Try to use integrated security if no username is supplied.
strConnect = strConnect & ";Integrated Security=SSPI"
End If
WScript.Echo "Setting connection string to " & strConnect
oApplication.CurrentProject.OpenConnection strConnect
oApplication.Quit()
Set oApplication = Nothing
End Function
To run it, just use the following from the commandline:
cscript connect.vbs Project.adp, "ServerName", "DatabaseName", "Username", "Password"

Related

How to encrypt Access with password using code?

I created a Deploy Access file which I use to deploy my production Access file. This re-links tables to production SQL server, incorporates disabling use of Shift, add new version number.... I need also encrypt the production Access file with a password. This should be done using code in my Deploy Access file but I cannot find a way to do it. Any ideas? Thanks.
Try this function:
Public Function SetDatabasePassword(strDatabasePath As String, Optional pNewPassword As Variant, Optional pOldPassword As Variant) As String
On Error GoTo SetDatabasePassword_Error
DoCmd.Hourglass True
Const cProvider = "Microsoft.ACE.OLEDB.12.0"
Dim cnn As ADODB.Connection
Dim strNewPassword As String
Dim strOldPassword As String
Dim strCommand As String
Dim strResult As String
' If a password is not specified (IsMissing), ' the string is "NULL" WITHOUT the brackets
If IsMissing(pNewPassword) Then
strNewPassword = "NULL"
Else
strNewPassword = "[" & pNewPassword & "]"
End If
If IsMissing(pOldPassword) Then
strOldPassword = "NULL"
Else
strOldPassword = "[" & pOldPassword & "]"
End If
strCommand = "ALTER DATABASE PASSWORD " & strNewPassword & " " & strOldPassword & ";"
Set cnn = New ADODB.Connection
With cnn
.Mode = adModeShareExclusive
.Provider = cProvider
If Not IsMissing(pOldPassword) Then
.Properties("Jet OLEDB:Database Password") = pOldPassword
End If
.Open "Data Source=" & strDatabasePath & ";"
.Execute strCommand
End With
strResult = "Password Set"
ExitProc_:
On Error Resume Next
cnn.Close
Set cnn = Nothing
SetDatabasePassword = strResult
DoCmd.Hourglass False
Exit Function
SetDatabasePassword_Error:
DoCmd.Hourglass False
If Err.Number = -2147467259 Then
strResult = "An error occured"
ElseIf Err.Number = -2147217843 Then
strResult = "Invalid password"
Else
strResult = Err.Number & " " & Err.Description
End If
Resume ExitProc_
Resume ' use for debugging
End Function

Why does connection string work on development machine only?

I have written 2 programs, one in VB6 and one in VBA for Excel. Calling the mySQL connection works perfectly in both on the development machine only. Trying to run either program on any other machine fails. Code is as follows:
Private Sub cmdErrors_Click()
On Error GoTo remote_err
Set myCon = New ADODB.Connection
strConnect = "Driver={MySQL ODBC 5.3 ANSI
Driver};Server=xxx.xxx.xxx.xxx;Port=3306;Database=cl22-budget;User=username;
Password=password;Option=3;"
myCon.ConnectionString = strConnect
myCon.Open
MsgBox "Connected"
myCon.Close
Set myCon = Nothing
Exit Sub
remote_err:
Dim ErrorCollection As Variant
Dim ErrLoop As Error
Dim strError As String
Dim iCounter As Integer
On Error Resume Next
iCounter = 1
strError = ""
Set ErrorCollection = myCon.Errors
For Each ErrLoop In ErrorCollection
With ErrLoop
strError = "error # " & iCounter & vbCrLf
strError = strError & "ADO Error # " & .Number & vbCrLf
strError = strError & " Description " & .Description & vbCrLf
strError = strError & " Source " & .Source & vbCrLf
MsgBox strError
iCounter = iCounter + 1
End With
Next
End Sub
Install ODBC Driver and create a DSN for your DB and there it will ask for server address there you mention your server ip then it will work.

Linking tables in Access

I have an access database that links to 6 tables. These tables are updated weekly and kept in a folder with the date. I would like for my access program to ask the user to select the location of the tables with out specifically using the Linked Table Manager.
The following code will prompt a user for the full path and file name of the database to be linked to. I decided to do this rather than just prompt for a folder. I strongly suggest you look at the connect string for one of your linked tables and make sure no other parameters are specified other than something like ';DATABASE=C:\Foldera\YYMMDD\MyAccessDB.mdb"
Private Function ReLinkTables()
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim tdf2 As DAO.TableDef
Dim strConn As String
Dim strNewPath As String
Dim strTableName As String
On Error GoTo ERROR_HANDLER
' Prompt user for new path...
strNewPath = GetFolder
' Exit if none
If strNewPath = "" Then
Exit Function
End If
Set dbs = CurrentDb
dbs.TableDefs.Refresh
' Find all the linked tables...
For Each tdf In dbs.TableDefs
'Debug.Print tdf.Name & vbTab & tdf.Connect
If Len(tdf.Connect) > 0 Then
strTableName = tdf.Name
Debug.Print "Linked Table: " & tdf.Name & vbTab & tdf.Connect
dbs.TableDefs.Delete strTableName ' Delete the linked table
strConn = ";DATABASE=" & strNewPath
Set tdf2 = CurrentDb.CreateTableDef(strTableName, dbAttachSavePWD, strTableName, strConn)
CurrentDb.TableDefs.Append tdf2
Else ' Not a linked table
'Debug.Print "Keep: " & tdf.Name & vbTab & tdf.Connect
End If
Next tdf
Set tdf = Nothing
Set tdf2 = Nothing
dbs.TableDefs.Refresh
dbs.Close
Set dbs = Nothing
MsgBox "Finished Relinking Tables"
Proc_Exit:
Exit Function
ERROR_HANDLER:
Debug.Print Err.Number & vbTab & Err.Description
Err.Source = "Module_Load_SQLSERVER_DATABASE: ReLinkTables at Line: " & Erl
If Err.Number = 9999 Then
Resume Next
End If
MsgBox Err.Number & vbCrLf & Err.Description
Resume Proc_Exit
Resume Next
End Function
Function GetFolder() As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFilePicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
'.InitialFileName = "Z:\xxxxxxxx" ' You can change to valid start path
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
Debug.Print "User selected path: >" & sItem & "<"
If sItem = "" Then MsgBox "User did not select a path.", vbOKOnly, "No Path"
GetFolder = sItem
Set fldr = Nothing
End Function

Access VBA: Recordset should be NOT nothing

I have a Front-End database setup for users to extract data regarding a list of information that they upload. The export function worked fine except they want the results to go to the open workbook add a sheet with the data without saving. The problem is that the created query has data when I run the query before or after the macro is not running. However as the macro is running the query returns nothing. The latest VBA I'm using is below. Please review and advise what I'm missing.
Thank you,
MS Office - Access: 2010
Active Reference Library:
Visual Basic for applications
Microsoft Access 14.0 Object Library
OLE Automation
Microsoft Excel 14.0 Object Library
Microsoft Office
14.0 Access database engine Object Library
Macro:
Private Sub ExpFile_Click()
Dim sql2export, s As String, blnExcel, blnWhere As Boolean, qdf As QueryDef, xlApp As Object, ws As Excel.Worksheet
Dim MyDatabase As DAO.Database, MyQueryDef As DAO.QueryDef, MyRecordset As DAO.Recordset
blnWhere = False
If Me. QueryASubform.Visible = True Then 'exceptions
sql2export = "QueryA"
blnWhere = True
ElseIf Me. QueryBSubform.Visible.Visible = True Then 'no Program Group for Build ID
sql2export = " QueryB"
ElseIf Me. QueryCSubform.Visible = True Then 'Bill to and Type report.
sql2export = " QueryC"
Else: Exit Sub
End If
If blnWhere = False Then
s = "select * from " & sql2export & " Where (((" & sql2export & ". GPID)=[Forms]![frmFEFindQA]![GPID]));"
Else: s = "select * from " & sql2export
End If
On Error Resume Next
CurrentDb.QueryDefs.Delete "xlsExport"
Set qdf = CurrentDb.CreateQueryDef("xlsExport", s)
Set xlApp = GetObject(, "excel.application")
If (Err.Number = 0) Then
Set xlApp = GetObject("Excel.Application")
xlApp.Visible = True
Set ws = xlApp.Sheets.Add
Set MyDatabase = CurrentDb
MyDatabase.QueryDefs.Delete ("xlsExport")
Set MyQueryDef = MyDatabase.CreateQueryDef("xlsExport", s)
Set MyRecordset = MyDatabase.OpenRecordset("xlsExport") ‘<------ empty
With xlApp
.ws.Select
.ActiveSheet.Range("a2").CopyFromRecordset MyRecordset
For i = 1 To MyRecordset.Fields.Count
xlApp.ActiveSheet.Cells(1, i).Value = MyRecordset.Fields(i - 1).Name
Next i
xlApp.Cells.EntireColumn.AutoFit
End With
Else:
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "xlsExport", "C:\Users\" & Environ("USERNAME") & "\Documents\VehInfoExp", True
xlApp.Workbooks.Open "C:\Users\" & Environ("USERNAME") & "\Documents\InfoExp.xls", True, False
End If
Err.Clear
On Error GoTo 0
Set xlApp = Nothing
End Sub
Arg, I found the answer. After a week of trying I decided to post the question and then I figured it out an hour later.
The issue is in the "Where" clause of the SQL. I needed to capture the value of the form as a variable and put it into the equation. For some reason while the macro is running the referenced part of the form was valued as nothing. So nothing was returned.
Therefore, the following line of SQL:
s = "select * from " & sql2export & " Where (((" & sql2export & ".GPID)=[Forms]![frmFEFindQA]![GPID]));"
Became:
s = "select * from " & sql2export & " Where (((" & sql2export & ".GPID)=""" & strWhere & """));"
Thank you for letting me post.

Deploy Access 2007 Database with SQL back end to Citrix for multiple users

Situation:
I recently took IT Support ownership of our Time Tracking database at my company (the old owner left). This was written in Access 2007 and uses SQL Server 2008 R2 Tables and views in the back end. We publish a locked (db.accde) version to our Citrix farm and users access it by logging into a citrix web portal and clicking on the icon for the Access Database. I have a need to move this from once server to a different server so the old one can be sunset. I tried simply copying the file on the existing server to the new server (which is running Office 2010 apps) and creating a new icon on the citrix portal to point to it.
Problem:
Now that it is there only 1 person can open it at a time (used to be usable by multiple users) Also it needs to know who I am (for appropriate permissions within the DB) and it doesn't seem to have a clue. It is giving errors related to the SQL connection. The way it figures out who you are and what permissions you should have is by checking Active Directory and if you belong to the correct NT group then you can have access to additional Forms, if not you only see the basic user forms. Right now everyone who opens it from Citrix only sees the "basic user forms" regardless of the NT Groups they are assigned to.
Question:
I am not an advanced developer when it comes to Access and VB. I also know very little about how Citrix works. I am wondering if when I copied the DB to the new server if there was something I didn't do that should have happened. For instance when you open the "existing link" which opens the "existing Access db" for a brief second there is a CMD screen that pops up and goes away prior to the access DB opening. on the new link that is not happening.
If anyone has any expertise they can toss my way to help me go down the right path of figuring this out it would be greatly appreciated.
For various reasons, it is a VBscript. PowerShell could be used as well.
The "trick" is to use the user's LocalAppData folder to host the accdb file as the user always has been granted full rights here.
It worked from the first attempt. The version number is caused by minor changes, including changed names of the local folders, only.
The users received a link to a read-only copy of the script in a shared folder and - when double-clicked - ran and created a shortcut on the user's desktop for future launch of the application. Users had by default Access 2010 installed so no runtime was needed.
The script carries out these tasks:
creates subfolders in the user's LocalAppData folder
kills the application should it be running
copies the current version of the application to the local folder
copies a second copy (launched by the first for background tasks)
creates/copies a shortcut
writes the security settings for the application in the Registry
launches the application (which then launches the background application)
The result is that the user at each launch updates the application, thus deployment of new application versions is "automatic".
Please study the in-line comments for details.
Option Explicit
' Launch script for PPT test/development/operation.
' Version 1.3.0
' 2013-09-15
' Cactus Data. Gustav Brock
Const DESKTOP = &H10
Const LOCALAPPDATA = &H1C
Dim objFSO
Dim objAppShell
Dim objDesktopFolder
Dim objLocalAppDataFolder
Dim objLocalFolder
Dim objRemoteFolder
Dim strLocalFolder
Dim strRemoteFolder
Dim strDesktopFolder
Dim strLocalAppDataFolder
Dim strLocalAppDataDsgFolder
Dim strLocalAppDataDsgPptFolder
Dim strDsgSubfolder
Dim strPptSubfolder
Dim strPptAppSubfolder
Dim strPptNcSuffix
Dim strAppName
Dim strAppSuffix
Dim strShortcutName
Dim strAppLocalPath
Dim strAppLocalBackPath
Dim strAppRemotePath
Dim strShortcutLocalPath
Dim strShortcutRemotePath
Dim strRegPath
Dim strRegKey
Dim strRegValue
Dim booNoColour
Dim varValue
' Adjustable parameters.
strDsgSubfolder = "DSG"
strPptSubfolder = "PPT"
strPPtNcSuffix = "NC"
' ---------------------------------------------------------------------------------
' Uncomment one folder name only:
'strPptAppSubfolder = "Development"
strPptAppSubfolder = "Operations"
'strPptAppSubfolder = "Test"
' ---------------------------------
' Indicate if the script is for the normal version (0) or the no-colour version (1):
booNoColour = 0
' ---------------------------------------------------------------------------------
strRemoteFolder = "K:\_Shared\Sales Planning\Environments\" & strPptAppSubfolder
If booNoColour = 1 Then
strAppSuffix = strPptNcSuffix
Else
strAppSuffix = ""
End If
strAppName = "SalesPlanningTool" & strAppSuffix & ".accdb"
If strPptAppSubfolder = "Operations" Then
If strAppSuffix = "" Then
strShortcutName = "RunPPT.lnk"
Else
strShortcutName = "RunPPT " & strAppSuffix & ".lnk"
End If
Else
If strAppSuffix = "" Then
strShortcutName = "RunPPT " & strPptAppSubfolder & ".lnk"
Else
strShortcutName = "RunPPT " & strAppSuffix & " " & strPptAppSubfolder & ".lnk"
End If
End If
' Enable simple error handling.
On Error Resume Next
' Find user's Desktop and AppData\Local folder.
Set objAppShell = CreateObject("Shell.Application")
Set objDesktopFolder = objAppShell.Namespace(DESKTOP)
strDesktopFolder = objDesktopFolder.Self.Path
Set objLocalAppDataFolder = objAppShell.Namespace(LOCALAPPDATA)
strLocalAppDataFolder = objLocalAppDataFolder.Self.Path
' Dynamic parameters.
strLocalAppDataDsgFolder = strLocalAppDataFolder & "\" & strDsgSubfolder
strLocalAppDataDsgPptFolder = strLocalAppDataDsgFolder & "\" & strPptSubfolder
strLocalFolder = strLocalAppDataDsgPptFolder & "\" & strPptAppSubfolder
strAppLocalPath = strLocalFolder & "\" & strAppName
strShortcutLocalPath = strDesktopFolder & "\" & strShortcutName
' Permanent parameters.
strAppRemotePath = strRemoteFolder & "\" & strAppName
strShortcutRemotePath = strRemoteFolder & "\" & strShortcutName
' Create the File System Object.
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FolderExists(strRemoteFolder) Then
Call ErrorHandler("No access to " & strRemoteFolder & ".")
Else
Set objRemoteFolder = objFSO.GetFolder(strRemoteFolder)
' If local folder does not exist, create the folder.
If Not objFSO.FolderExists(strLocalFolder) Then
If Not objFSO.FolderExists(strLocalAppDataDsgFolder) Then
Set objLocalFolder = objFSO.CreateFolder(strLocalAppDataDsgFolder)
If Not Err.Number = vbEmpty Then
Call ErrorHandler("Folder " & strLocalAppDataDsgFolder & " could not be created.")
End If
End If
If Not objFSO.FolderExists(strLocalAppDataDsgPPtFolder) Then
Set objLocalFolder = objFSO.CreateFolder(strLocalAppDataDsgPptFolder)
If Not Err.Number = vbEmpty Then
Call ErrorHandler("Folder " & strLocalAppDataDsgPptFolder & " could not be created.")
End If
End If
If Not objFSO.FolderExists(strLocalFolder) Then
Set objLocalFolder = objFSO.CreateFolder(strLocalFolder)
If Not Err.Number = vbEmpty Then
Call ErrorHandler("Folder " & strLocalFolder & " could not be created.")
End If
End If
End If
Set objLocalFolder = objFSO.GetFolder(strLocalFolder)
End If
If Not objFSO.FileExists(strAppRemotePath) Then
Call ErrorHandler("The application file:" & vbCrLf & strAppRemotePath & vbCrLF & "could not be found.")
Else
' Close a running PPT.
Call KillTask("PPT")
' Wait while TaskKill is running twice to close the instance(s) of PPT and PPT Background.
Call AwaitProcess("taskkill.exe")
Call KillTask("PPT Background")
' Wait while TaskKill is running twice to close the instance(s) of PPT and PPT Background.
Call AwaitProcess("taskkill.exe")
' Copy app to local folder.
If objFSO.FileExists(strAppLocalPath) Then
objFSO.DeleteFile(strAppLocalPath)
If Not Err.Number = 0 Then
Call ErrorHandler("The application file:" & vbCrLf & strAppName & vbCrLF & "can not be refreshed/updated. It may be in use.")
End If
End If
If objFSO.FileExists(strAppLocalPath) Then
Call ErrorHandler("The local application file:" & vbCrLf & strAppLocalPath & vbCrLF & "could not be replaced.")
Else
objFSO.CopyFile strAppRemotePath, strAppLocalPath
If Not Err.Number = vbEmpty Then
Call ErrorHandler("Application could not be copied to " & strLocalFolder & ".")
End If
' Create copy for PPT Background.
strAppLocalBackPath = Replace(Replace(strAppLocalPath, ".accdb", ".accbg"), "SalesPlanningTool", "SalesPlanningToolBack")
objFSO.CopyFile strAppLocalPath, strAppLocalBackPath
If Not Err.Number = vbEmpty Then
Call ErrorHandler("Background application could not be copied to " & strLocalFolder & ".")
End If
End If
' Copy shortcut.
objFSO.CopyFile strShortcutRemotePath, strShortcutLocalPath
If Not Err.Number = vbEmpty Then
Call ErrorHandler("Shortcut could not be copied to your Desktop.")
End If
End If
' Write Registry entries for Access security.
strRegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Access\Security\"
strRegValue = "VBAWarnings"
strRegPath = strRegKey & strRegValue
varValue = 1
Call WriteRegistry(strRegPath, varValue,"REG_DWORD")
strRegKey = strRegKey & "Trusted Locations\LocationLocalAppData\"
strRegValue = "AllowSubfolders"
strRegPath = strRegKey & strRegValue
varValue = 1
Call WriteRegistry(strRegPath, varValue, "REG_DWORD")
strRegValue = "Date"
strRegPath = strRegKey & strRegValue
varValue = Now
varValue = FormatDateTime(varValue, vbShortDate) & " " & FormatDateTime(varValue, vbShortTime)
Call WriteRegistry(strRegPath, varValue, "REG_SZ")
strRegValue = "Description"
strRegPath = strRegKey & strRegValue
varValue = "Local AppData"
Call WriteRegistry(strRegPath, varValue, "REG_SZ")
strRegValue = "Path"
strRegPath = strRegKey & strRegValue
varValue = strLocalAppDataFolder & "\"
Call WriteRegistry(strRegPath, varValue, "REG_SZ")
' Run PPT.
If objFSO.FileExists(strAppLocalPath) Then
Call RunApp(strAppLocalPath, False)
Else
Call ErrorHandler("The local application file:" & vbCrLf & strAppLocalPath & vbCrLF & "could not be found.")
End If
Set objRemoteFolder = Nothing
Set objLocalFolder = Nothing
Set objLocalAppDataFolder = Nothing
Set objDesktopFolder = Nothing
Set objAppShell = Nothing
Set objFSO = Nothing
WScript.Quit
' Supporting subfunctions
' -----------------------
Sub RunApp(ByVal strFile, ByVal booBackground)
Dim objShell
Dim intWindowStyle
' Open as default foreground application.
intWindowStyle = 1
Set objShell = CreateObject("WScript.Shell")
objShell.Run Chr(34) & strFile & Chr(34), intWindowStyle, False
Set objShell = Nothing
End Sub
Sub KillTask(ByVal strWindowTitle)
Dim objShell
Set objShell = CreateObject("WScript.Shell")
objShell.Run "TaskKill.exe /FI ""WINDOWTITLE eq " & strWindowTitle & """", 7, False
Set objShell = Nothing
End Sub
Sub AwaitProcess(ByVal strProcess)
Dim objSvc
Dim strQuery
Dim colProcess
Dim intCount
Set objSvc = GetObject("winmgmts:root\cimv2")
strQuery = "select * from win32_process where name='" & strProcess & "'"
Do
Set colProcess = objSvc.Execquery(strQuery)
intCount = colProcess.Count
If intCount > 0 Then
WScript.Sleep 300
End If
Loop Until intCount = 0
Set colProcess = Nothing
Set objSvc = Nothing
End Sub
Sub WriteRegistry(ByVal strRegPath, ByVal varValue, ByVal strRegType)
' strRegType should be:
' "REG_SZ" for a string
' "REG_DWORD" for an integer
' "REG_BINARY" for a binary or boolean
' "REG_EXPAND_SZ" for an expandable string
Dim objShell
Set objShell = CreateObject("WScript.Shell")
Call objShell.RegWrite(strRegPath, varValue, strRegType)
Set objShell = Nothing
End Sub
Sub ErrorHandler(Byval strMessage)
Set objRemoteFolder = Nothing
Set objLocalFolder = Nothing
Set objLocalAppDataFolder = Nothing
Set objDesktopFolder = Nothing
Set objAppShell = Nothing
Set objFSO = Nothing
WScript.Echo strMessage
WScript.Quit
End Sub