Solved

script help please

Posted on 2015-01-23
9
100 Views
Last Modified: 2015-01-23
Hi all I am trying to use this script to create some RDP Shortcuts in the Start Menu. The issue is that there are some variations to what shortcut is created. I have used the Case option to differentiate the process. When first run, the folder gets created, and the shortcut is created...all that is great. Now if the same user needs another shortcut, the script errors out saying the folder exists, which is true. What I would like the script to do is that if the folder exist to simply ignore that it exists and perform the copy function of putting the short cut in the folder.
strStartMenu = WshShell.SpecialFolders("AllUsersStartmenu")
strMenu = "C:\ProgramData\Microsoft\Windows\Start Menu\Programs"
strShortcut = WshShell.ExpandEnvironmentStrings("%Public%") & "\Desktop" 
strRDP = "\\Hplandesk95\packages\Medassurant\Catalyst (RDP)\Source"
strRDP23 = "\\Hplandesk95\packages\Medassurant\Catalyst (RDP)\Source\LCD23"
'Create folder to place shortcuts
	If Not objFSO.FolderExists ("C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Medassurant") Then
	objFSO.CreateFolder strStartMenu & "\Medassurant\"
	End If
Select Case UCase(strEnv)
	Case "HPQSHR" 			
	objFSO.CopyFile strRDP & "\HPQSHR.RDP" , strStartMenu & "\Medassurant\HPQSHR.RDP", True 	
		
	Case "HPQSI" 
	objFSO.CopyFile strRDP & "\HPQSI.RDP" , strStartMenu & "\Medassurant\HPQSI.RDP", True
		 		
	Case "HPQSHR(LCD23)" 
	objFSO.CopyFile strRDP23 & "\HPQSHR_(LCD23).RDP" , strStartMenu & "\Medassurant\HPQSHR_(LCD23).RDP", True
		 	
		
	Case "HPQSI(LCD23)" 
	objFSO.CopyFile strRDP23 & "\HPQSI_(LCD23).RDP" , strStartMenu & "\Medassurant\HPQSI_(LCD23).RDP", True
		 
		
	Case Else ' Default = HPQSHR
	objFSO.CopyFile strRDP & "\HPQSHR.RDP" , strStartMenu & "\Medassurant\HPQSHR.RDP", True
		 		
End Select

Open in new window

0
Comment
Question by:xzay1967
  • 3
  • 3
  • 3
9 Comments
 
LVL 35

Assisted Solution

by:Kimputer
Kimputer earned 250 total points
ID: 40566335
Either use

If Not objFSO.FolderExists ("C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Medassurant") Then
	objFSO.CreateFolder strStartMenu & "\Programs\Medassurant\"
	End If

Open in new window


or

If Not objFSO.FolderExists ("C:\ProgramData\Microsoft\Windows\Start Menu\Medassurant") Then
	objFSO.CreateFolder strStartMenu & "\Medassurant\"
	End If

Open in new window


Because you check one thin in the IF then use another to create, you will get it mixed up. Both IF and create should be the same (otherwise, why use this IF statement)?

Since you know your error now, please adjust the following copy lines as well (if first solution was chosen).
0
 
LVL 9

Expert Comment

by:skipper68
ID: 40566345
You're trying to create the folder using strStartMenu variable instead of strMenu.  strMenu contains the directory path. :-)

Try this
'Create folder to place shortcuts
	If Not objFSO.FolderExists (strMenu & "\Medassurant\") Then
	objFSO.CreateFolder strMenu & "\Medassurant\"
	End If

Open in new window

0
 

Author Comment

by:xzay1967
ID: 40566546
Thanks guys, but the problem is not the path not being found, the issue is that once the Medassurant folder gets created, then I try to run subsequent process to create another shortcut, it errors saying the folder already exist and does not place the shortcut. I want that if the folder is there (created from a prior run) to still create the shortcut.
0
 
LVL 35

Expert Comment

by:Kimputer
ID: 40566581
What you're saying is that that's NOT the full code? If not, we need to see the code of your "subsequent process" of course.
If this IS the full code, we found the error, but you refuse to see it (as both me and other expert clearly see you will get an error on line 8). If the script stops at line 8, then why do 2 expert give the same answer? If the script stops at another line, please give us full code and line number.
0
Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

 

Author Comment

by:xzay1967
ID: 40566589
Sorry not trying to cause any trouble. Here is the full code. stops at line 128,2 file already exists. This is when I have already used case hpqshr, then try to use case hpqshr(lcd23) for a subsequent run
'===============================================================
'=== Packaging VBScript Template
'=== Author: Zay
'=== 
'=== Revision History:
'=== 09/04/2012:  v1.0 - Initial Release
'===
'===============================================================
Dim objIEDebugWindow
Dim objFSO, objFolder, WshShell, objTextFile, objFile, objProcess
Dim oReg, arrSubkeys, strSubkey
Dim AppName, AppVer, Log_File, Bit32_64, ReturnCode, ReturnCode_Err
Dim strDirectory,  strText, strKeyPath, strValueName, strValue, strComputer
Dim Scanner_File, strCurrentDir
Dim strPath, strScriptFolder, strCommand, strScriptPath, strScriptFullName
Dim strEnv, strMode, strLD, strRDP, strRDP23, strStartMenu
Dim strURL, strShortCutName, strIcon, strShortcut, strMenu

'=========================
'=== Script Parameters ===
'=========================
Set colNamedArguments = WScript.Arguments.Named

If colNamedArguments.Exists("Env") Then
	strEnv = UCase(colNamedArguments.Item("Env"))
Else
	strEnv = "HPQSHR"
End If 

If colNamedArguments.Exists("Mode") Then
	strMode = UCase(colNamedArguments.Item("Mode"))
Else
	strMode = "INSTALL"
End If

If colNamedArguments.Exists("LD") Then
	strLD = UCase(colNamedArguments.Item("LD"))
Else
	strLD = "95" 
End If
'===============================
'=== Application Information ===
'===============================

AppName = "Medassurant RDP Shortcuts"
AppVer = "v1.0"

'Const HKEY_CLASSES_ROOT   = &H80000000
'Const HKEY_CURRENT_USER   = &H80000001
Const HKEY_LOCAL_MACHINE  = &H80000002
'Const HKEY_USERS          = &H80000003

Const OverwriteExisting = True

strComputer = "." ' Use . for current machine

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")  
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &_
	strComputer & "\root\default:StdRegProv")

'============================
'=== Get Script Directory ===
'============================ 
strPath = WScript.ScriptFullName
strCurrentDir = WshShell.CurrentDirectory
Set objFile = objFSO.GetFile(strPath)
strScriptFolder = objFSO.GetParentFolderName(objFile) & "\"
'WScript.Echo strScriptFolder

'==========================
'=== Log File Directory ===
'==========================
strDirectory = "c:\logs\appinst"
Log_File = strDirectory & "\" & AppName & "_" & AppVer & "_" & strEnv & "_" & strMode & ".log"
If objFSO.FolderExists(strDirectory) Then
   Set objFolder = objFSO.GetFolder(strDirectory)
Else
   Set objFolder = objFSO.CreateFolder(strDirectory)
   'WScript.Echo "Created Directory: " & strDirectory
End If

If objFSO.FileExists(Log_File) Then
   Set objFolder = objFSO.GetFolder(strDirectory)
Else
   Set objFile = objFSO.CreateTextFile(Log_File)
	objFile.Close
	'Wscript.Echo "Created Logfile: " & Log_File
End If 

Set objFile = Nothing
Set objFolder = Nothing
'=== OpenTextFile Method needs a Const value
'=== ForAppending = 8, ForReading = 1, ForWriting = 2
Const ForAppending = 8
'=== End Log File Declaration ===

'==============================
'=== Initialize Error Codes ===
'==============================
ReturnCode = 0 
ReturnCode_Err = 0

'===================================
'=== Begin - Initialize Log File ===
'===================================
Set objTextFile = objFSO.OpenTextFile(Log_File, ForAppending, True)
objTextFile.WriteLine("=====================================================")
objTextFile.WriteLine(Now & ": Begin Execution")
objTextFile.WriteLine(Now & ": Log File = " & Log_File)
'=== End Initialize Log File ===

'=== Determine 32-bit or 64-bit OS
strKeyPath = "SYSTEM\CurrentControlSet\Control\Session Manager\Environment"
strValueName = "PROCESSOR_ARCHITECTURE"
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,Bit32_64

'==================================
'=== BEGIN: ShortCut Parameters ===
'==================================
'If UCase(strEnv) = "MSTR" Then
strStartMenu = WshShell.SpecialFolders("AllUsersStartmenu")
strMenu = "C:\ProgramData\Microsoft\Windows\Start Menu\Programs"
strShortcut = WshShell.ExpandEnvironmentStrings("%Public%") & "\Desktop" 
strRDP = "\\Hplandesk95\packages\Medassurant\Catalyst (RDP)\Source"
strRDP23 = "\\Hplandesk95\packages\Medassurant\Catalyst (RDP)\Source\LCD23"
'Create folder to place shortcuts
	If Not objFSO.FolderExists ("C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Medassurant") Then
	objFSO.CreateFolder strStartMenu & "\Medassurant\"
	End If
Select Case UCase(strEnv)
	Case "HPQSHR" 			
	objFSO.CopyFile strRDP & "\HPQSHR.RDP" , strStartMenu & "\Medassurant\HPQSHR.RDP", True 	
		
	Case "HPQSI" 
	objFSO.CopyFile strRDP & "\HPQSI.RDP" , strStartMenu & "\Medassurant\HPQSI.RDP", True
		 		
	Case "HPQSHR(LCD23)" 
	objFSO.CopyFile strRDP23 & "\HPQSHR_(LCD23).RDP" , strStartMenu & "\Medassurant\HPQSHR_(LCD23).RDP", True
		 	
		
	Case "HPQSI(LCD23)" 
	objFSO.CopyFile strRDP23 & "\HPQSI_(LCD23).RDP" , strStartMenu & "\Medassurant\HPQSI_(LCD23).RDP", True
		 
		
	Case Else ' Default = HPQSHR
	objFSO.CopyFile strRDP & "\HPQSHR.RDP" , strStartMenu & "\Medassurant\HPQSHR.RDP", True
		 		
End Select

'=== ShortCut Location
strShortcut = WshShell.ExpandEnvironmentStrings("%Public%") & "\Desktop"

'=== Shortcut Icon
If objFSO.FileExists("C:\Windows\System32\mstsc.exe") Then
	strIcon = "C:\Windows\System32\mstsc.exe,0"
Else 
	strIcon = "\\Hplandesk95\packages\Medassurant\mstsc_101.ico"
End If 	
'=== END: Shortcut Parameters
	
'==============================
'=== BEGIN: INSTALL Section ===
'==============================
If UCase(strMode) = "INSTALL" Then 
	
	' CreateShortcut strPath, strShortCutName, strURL, strIcon
' 	objTextFile.WriteLine(Now & " : Creating " & strShortCutName & " shortcut")

Else '=== END: Install Section
'===============================
'=== Begin UNINSTALL Section ===
'===============================
	If ucase(strMode) = "UNINSTALL" Then
		
		if objFSO.FileExists (strPath & "\" & strShortCutName & ".RDP") Then 
			objFSO.DeleteFile (strPath & "\" & strShortCutName & ".RDP")
			objTextFile.WriteLine(Now & " : Deleting " & strShortCutName & " shortcut")
		End If 	
		
		objTextFile.WriteLine(Now & ": =============================================================")
		objTextFile.WriteLine("")
		objTextFile.Close
		
		CleanUp()
		WScript.Quit
	
	End If '=== END: Uninstall Section ===	

End If '=== Install Mode

	
'=== Run LANDesk Inventory Scan
If strLD = "9" Then
	LDInv9()
Else 
	'LDInv95()
End If
		
objTextFile.WriteLine("=====================================================")	
objTextFile.Close
'=== End Post-Installation Configuration Section ===

'=== Cleanup ===
CleanUp()

WScript.Quit

'===================================
'=== DO NOT EDIT BELOW THIS LINE ===
'===================================

'==============================
'=== SubRoutine / Functions ===
'==============================
Sub CleanUp() 
	Set objIEDebugWindow = Nothing
	Set oReg = Nothing
	Set objFSO = Nothing
	Set objFolder = Nothing
	Set WshShell = Nothing
	Set objTextFile = Nothing
	Set objFile = Nothing
	Set objProcess = Nothing
	Set AppName = Nothing
	Set AppVer = Nothing
	Set Bit32_64 = Nothing
	Set ReturnCode = Nothing
	Set ReturnCode_Err = Nothing
	Set strDirectory = Nothing
	Set Log_File = Nothing
	Set strText = Nothing
	Set strKeyPath = Nothing
	Set strValueName = Nothing
	Set strValue = Nothing
	Set strComputer = Nothing
	Set Scanner_File = Nothing
	Set strPath = Nothing
	Set strScriptFolder = Nothing
	Set strCommand = Nothing
	Set strShortCutName = Nothing
	Set strURL = Nothing 
	Set strIcon = Nothing
End Sub 

' Function CreateShortcut(Path, ShortCutName, URL, Icon)
' 
' 	Set objShortcutUrl = WshShell.CreateShortcut(Path & "\" & ShortCutName & ".RDP")
' 	objShortcutUrl.TargetPath = URL 
' 	objShortcutUrl.IconLocation = Icon 
' 	'objShortcutUrl.Save
' 
' End Function 



' Reads a REG_SZ value from the local computer's registry using WMI.
' Parameters:
'   RootKey - The registry hive (see http://msdn.microsoft.com/en-us/library/aa390788(VS.85).aspx for a list of possible values).
'   Key - The key that contains the desired value.
'   Value - The value that you want to get.
'   RegType - The registry bitness: 32 or 64.

Function ReadRegStr (RootKey, Key, Value, RegType)
    Dim oCtx, oLocator, oReg, oInParams, oOutParams

    Set oCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
    oCtx.Add "__ProviderArchitecture", RegType

    Set oLocator = CreateObject("Wbemscripting.SWbemLocator")
    Set oReg = oLocator.ConnectServer("", "root\default", "", "", , , , oCtx).Get("StdRegProv")

    Set oInParams = oReg.Methods_("GetStringValue").InParameters
    oInParams.hDefKey = RootKey
    oInParams.sSubKeyName = Key
    oInParams.sValueName = Value

    Set oOutParams = oReg.ExecMethod_("GetStringValue", oInParams, , oCtx)

    ReadRegStr = oOutParams.sValue
End Function

Function Is64Bit() 
    Is64Bit = False 
    Dim colOS : Set colOS = GetObject("WinMGMTS://").ExecQuery("SELECT AddressWidth FROM Win32_Processor",, 48) 
    Dim objOS 
    For Each objOS In colOS 
        If objOS.AddressWidth = 64 Then Is64Bit = True 
    Next 
End Function 

Sub InstallError (ReturnCode)
	'=== Retain ReturnCode if error and exit script if required component
	If ReturnCode <> 0 Then
		objTextFile.WriteLine(Now & ": *** Installation Error Encountered ***")
		objTextFile.WriteLine(Now & ": Return Code = " & ReturnCode)
		objTextFile.Close

		Set objFSO = Nothing
		Set objIEDebugWindow = Nothing
		Set oReg = Nothing
		Set objFSO = Nothing
		Set objFolder = Nothing
		Set WshShell = Nothing
		Set objTextFile = Nothing
		Set objFile = Nothing
		Set objProcess = Nothing
		Set AppName = Nothing
		Set AppVer = Nothing
		Set Bit32_64 = Nothing
		Set ReturnCode = Nothing
		Set ReturnCode_Err = Nothing
		Set strDirectory = Nothing
		Set Log_File = Nothing
		Set strText = Nothing
		Set strKeyPath = Nothing
		Set strValueName = Nothing
		Set strValue = Nothing
		Set strComputer = Nothing
		Set Scanner_File = Nothing
		Set strPath = Nothing
		Set strScriptFolder = Nothing
		Set strCommand = Nothing
		Set strShortCutName = Nothing
		Set strURL = Nothing
		Set strIcon = Nothing 

		WScript.Quit(ReturnCode)
	End If 	
End Sub

Sub Debug( myText )
	' Uncomment the next line to turn off debugging
	Exit Sub

  If Not IsObject( objIEDebugWindow ) Then
    Set objIEDebugWindow = CreateObject( "InternetExplorer.Application" )
    objIEDebugWindow.Navigate "about:blank"
    objIEDebugWindow.Visible = True
    objIEDebugWindow.ToolBar = False
    objIEDebugWindow.Width   = 200
    objIEDebugWindow.Height  = 300
    objIEDebugWindow.Left    = 10
    objIEDebugWindow.Top     = 10
    Do While objIEDebugWindow.Busy
      WScript.Sleep 100
    Loop
    objIEDebugWindow.Document.Title = "IE Debug Window"
    objIEDebugWindow.Document.Body.InnerHTML = _
                 "<b>" & Now & "</b></br>"
  End If

  objIEDebugWindow.Document.Body.InnerHTML = _
                   objIEDebugWindow.Document.Body.InnerHTML _
                   & myText & "<br>" & vbCrLf
End Sub

Function IsBlank(Value)
	'returns True if Empty or NULL or Zero
	If IsEmpty(Value) or IsNull(Value) Then
		IsBlank = True
		Exit Function
	ElseIf VarType(Value) = vbString Then
		If Value = "" Then
 			IsBlank = True
 			Exit Function
		End If
	ElseIf IsObject(Value) Then
		If Value Is Nothing Then
			IsBlank = True
			Exit Function
		End If
	ElseIf IsNumeric(Value) Then
		If Value = 0 Then
			'wscript.echo " Zero value found"
			IsBlank = True
  			Exit Function
		End If
	Else
		IsBlank = False
	End If
End Function

Function IsPingable(objItem)
	'On Error Resume Next
	Dim objShell, objExec, strCmd, strTemp
 
	strCmd = "ping -n 1 " & objItem
 
	Set objShell = CreateObject("WScript.Shell")
	Set objExec = objShell.Exec(strCmd)
	strTemp = UCase(objExec.StdOut.ReadAll)
 
	If InStr(strTemp, "MS") Then
		IsPingable = True 
	Else
		IsPingable = False
	End If
End Function

function Reachable(HostName)

	'=== Usage
	'=== machine = "www.yahoo.com"
	'=== if reachable(machine) Then
	'=== 		wscript.echo machine & " reachable"
	'=== else
	'=== 		wscript.echo machine & " not reachable"
	'=== end If
	
	dim wshShell, fso, tfolder, tname, TempFile, results, retString, ts
	Const ForReading = 1, TemporaryFolder = 2
	reachable = False
	set wshShell=wscript.createobject("wscript.shell")
	set fso = CreateObject("Scripting.FileSystemObject")
	Set tfolder = fso.GetSpecialFolder(TemporaryFolder)
	tname = fso.GetTempName
	TempFile = tfolder & tname
	'-w 100000 is 5 mins worth of timeout to cope with establishing a dialup
	wshShell.run "cmd /c ping -n 3 -w 1000 " & HostName & ">" & TempFile,0,true
	set results = fso.GetFile(TempFile)
	set ts = results.OpenAsTextStream(ForReading)
	do while ts.AtEndOfStream <> True
		retString = ts.ReadLine
		if instr(retString, "Reply")>0 then
			reachable = true
			exit do
		end if
	loop
	ts.Close
	results.delete
end Function

' Sub LDInv9()
' 	Dim Scanner_File
' 	
' 	Scanner_File = "C:\Program Files (x86)\LANDesk\LDClient\LDISCN32.EXE"
' 	If objFSO.FileExists (Scanner_File) Then 
' 		ReturnCode = WshShell.Run("""C:\Program Files (x86)\LANDesk\LDClient\LDISCN32.EXE"" /NTT=HPLANDESK9:5007 /S=HPLANDESK9  /I=HTTP://HPLANDESK9/ldlogon/ldappl3.ldz /NoUI /Sync /F",0,True)
' 		objTextFile.WriteLine(Now & ": Return Code = " & ReturnCode & " : Updating LANDesk Inventory")
' 	End If 
' 
' 	Set Scanner_File = Nothing
' 	
' End Sub  
' 
' Sub LDInv95()
' 	Dim Scanner_File
' 
' 	Scanner_File = "C:\Program Files (x86)\LANDesk\LDClient\LDISCN32.EXE"
' 	If objFSO.FileExists (Scanner_File) Then 
' 		ReturnCode = WshShell.Run("""C:\Program Files (x86)\LANDesk\LDClient\LDISCN32.EXE"" /NTT=HPLANDESK:5007 /S=HPLANDESK /I=HTTP://HPLANDESK/ldlogon/ldappl3.ldz /NoUI /Sync /F",0,True)
' 		objTextFile.WriteLine(Now & ": Return Code = " & ReturnCode & " : Updating LANDesk Inventory")
' 	End If 
' 	
' 	Set Scanner_File = Nothing
' 
' End Sub 

Function ShowAbsolutePath(path)
   'Dim fso
   'Set fso = CreateObject("Scripting.FileSystemObject")
   ShowAbsolutePath = objFSO.GetAbsolutePathName(path)
End Function

Function ScriptPath(strPath)
	Dim objFile2
	
	Set objFile2 = objFSO.GetFile(strPath)
	strFolder = objFSO.GetParentFolderName(objFile) & "\"
	
	'WScript.Echo strFolder
	'strPath = "explorer.exe /e," & strFolder
	'WshShell.Run strPath
	
End Function 	
	
'WriteIni "C:\test.ini", "TEST1", "My1stKey", "My1stValue"
'WriteIni "C:\test.ini", "TEST2", "My1stKey", "My1stValue"
'WScript.Echo ReadIni( "C:\test.ini", "TEST1", "My1stKey" )
'WriteIni "C:\test.ini", "TEST1", "My1stKey", "My2ndValue"
'WScript.Echo ReadIni( "C:\test.ini", "TEST1", "My1stKey" )

Function ReadIni( myFilePath, mySection, myKey )
    ' This function returns a value read from an INI file
    '
    ' Arguments:
    ' myFilePath  [string]  the (path and) file name of the INI file
    ' mySection   [string]  the section in the INI file to be searched
    ' myKey       [string]  the key whose value is to be returned
    '
    ' Returns:
    ' the [string] value for the specified key in the specified section
    '
    ' CAVEAT:     Will return a space if key exists but value is blank
    '
    ' Written by Keith Lacelle
    ' Modified by Denis St-Pierre and Rob van der Woude

    Const ForReading   = 1
    Const ForWriting   = 2
    Const ForAppending = 8

    Dim intEqualPos
    Dim objFSO, objIniFile
    Dim strFilePath, strKey, strLeftString, strLine, strSection

    Set objFSO = CreateObject( "Scripting.FileSystemObject" )

    ReadIni     = ""
    strFilePath = Trim( myFilePath )
    strSection  = Trim( mySection )
    strKey      = Trim( myKey )

    If objFSO.FileExists( strFilePath ) Then
        Set objIniFile = objFSO.OpenTextFile( strFilePath, ForReading, False )
        Do While objIniFile.AtEndOfStream = False
            strLine = Trim( objIniFile.ReadLine )

            ' Check if section is found in the current line
            If LCase( strLine ) = "[" & LCase( strSection ) & "]" Then
                strLine = Trim( objIniFile.ReadLine )

                ' Parse lines until the next section is reached
                Do While Left( strLine, 1 ) <> "["
                    ' Find position of equal sign in the line
                    intEqualPos = InStr( 1, strLine, "=", 1 )
                    If intEqualPos > 0 Then
                        strLeftString = Trim( Left( strLine, intEqualPos - 1 ) )
                        ' Check if item is found in the current line
                        If LCase( strLeftString ) = LCase( strKey ) Then
                            ReadIni = Trim( Mid( strLine, intEqualPos + 1 ) )
                            ' In case the item exists but value is blank
                            If ReadIni = "" Then
                                ReadIni = " "
                            End If
                            ' Abort loop when item is found
                            Exit Do
                        End If
                    End If

                    ' Abort if the end of the INI file is reached
                    If objIniFile.AtEndOfStream Then Exit Do

                    ' Continue with next line
                    strLine = Trim( objIniFile.ReadLine )
                Loop
            Exit Do
            End If
        Loop
        objIniFile.Close
    Else
        WScript.Echo strFilePath & " doesn't exists. Exiting..."
        Wscript.Quit 1
    End If
End Function

Sub WriteIni( myFilePath, mySection, myKey, myValue )
    ' This subroutine writes a value to an INI file
    '
    ' Arguments:
    ' myFilePath  [string]  the (path and) file name of the INI file
    ' mySection   [string]  the section in the INI file to be searched
    ' myKey       [string]  the key whose value is to be written
    ' myValue     [string]  the value to be written (myKey will be
    '                       deleted if myValue is <DELETE_THIS_VALUE>)
    '
    ' Returns:
    ' N/A
    '
    ' CAVEAT:     WriteIni function needs ReadIni function to run
    '
    ' Written by Keith Lacelle
    ' Modified by Denis St-Pierre, Johan Pol and Rob van der Woude

    Const ForReading   = 1
    Const ForWriting   = 2
    Const ForAppending = 8

    Dim blnInSection, blnKeyExists, blnSectionExists, blnWritten
    Dim intEqualPos
    Dim objFSO, objNewIni, objOrgIni, wshShell
    Dim strFilePath, strFolderPath, strKey, strLeftString
    Dim strLine, strSection, strTempDir, strTempFile, strValue

    strFilePath = Trim( myFilePath )
    strSection  = Trim( mySection )
    strKey      = Trim( myKey )
    strValue    = Trim( myValue )

    Set objFSO   = CreateObject( "Scripting.FileSystemObject" )
    Set wshShell = CreateObject( "WScript.Shell" )

    strTempDir  = wshShell.ExpandEnvironmentStrings( "%TEMP%" )
    strTempFile = objFSO.BuildPath( strTempDir, objFSO.GetTempName )

    Set objOrgIni = objFSO.OpenTextFile( strFilePath, ForReading, True )
    Set objNewIni = objFSO.CreateTextFile( strTempFile, False, False )

    blnInSection     = False
    blnSectionExists = False
    ' Check if the specified key already exists
    blnKeyExists     = ( ReadIni( strFilePath, strSection, strKey ) <> "" )
    blnWritten       = False

    ' Check if path to INI file exists, quit if not
    strFolderPath = Mid( strFilePath, 1, InStrRev( strFilePath, "\" ) )
    If Not objFSO.FolderExists ( strFolderPath ) Then
        WScript.Echo "Error: WriteIni failed, folder path (" _
                   & strFolderPath & ") to ini file " _
                   & strFilePath & " not found!"
        Set objOrgIni = Nothing
        Set objNewIni = Nothing
        Set objFSO    = Nothing
        WScript.Quit 1
    End If

    While objOrgIni.AtEndOfStream = False
        strLine = Trim( objOrgIni.ReadLine )
        If blnWritten = False Then
            If LCase( strLine ) = "[" & LCase( strSection ) & "]" Then
                blnSectionExists = True
                blnInSection = True
            ElseIf InStr( strLine, "[" ) = 1 Then
                blnInSection = False
            End If
        End If

        If blnInSection Then
            If blnKeyExists Then
                intEqualPos = InStr( 1, strLine, "=", vbTextCompare )
                If intEqualPos > 0 Then
                    strLeftString = Trim( Left( strLine, intEqualPos - 1 ) )
                    If LCase( strLeftString ) = LCase( strKey ) Then
                        ' Only write the key if the value isn't empty
                        ' Modification by Johan Pol
                        If strValue <> "<DELETE_THIS_VALUE>" Then
                            objNewIni.WriteLine strKey & "=" & strValue
                        End If
                        blnWritten   = True
                        blnInSection = False
                    End If
                End If
                If Not blnWritten Then
                    objNewIni.WriteLine strLine
                End If
            Else
                objNewIni.WriteLine strLine
                    ' Only write the key if the value isn't empty
                    ' Modification by Johan Pol
                    If strValue <> "<DELETE_THIS_VALUE>" Then
                        objNewIni.WriteLine strKey & "=" & strValue
                    End If
                blnWritten   = True
                blnInSection = False
            End If
        Else
            objNewIni.WriteLine strLine
        End If
    Wend

    If blnSectionExists = False Then ' section doesn't exist
        objNewIni.WriteLine
        objNewIni.WriteLine "[" & strSection & "]"
            ' Only write the key if the value isn't empty
            ' Modification by Johan Pol
            If strValue <> "<DELETE_THIS_VALUE>" Then
                objNewIni.WriteLine strKey & "=" & strValue
            End If
    End If

    objOrgIni.Close
    objNewIni.Close

    ' Delete old INI file
    objFSO.DeleteFile strFilePath, True
    ' Rename new INI file
    objFSO.MoveFile strTempFile, strFilePath

    Set objOrgIni = Nothing
    Set objNewIni = Nothing
    Set objFSO    = Nothing
    Set wshShell  = Nothing
End Sub

Function CloseAPP(Appname)
    'Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
    
    Set objWMIService = GetObject("winmgmts:" _
	& "{impersonationLevel=impersonate}!\\" _ 
	& strComputer & "\root\cimv2") 

	Set colProcess = objWMIService.ExecQuery _
		("Select * from Win32_Process Where Name = '" & Appname & "'")

	For Each objProcess in colProcess
		objProcess.Terminate()
	Next
    
End Function

Sub ReplaceIfNewer(strSourceFile, strTargetFile) 

	Dim objTargetFile 
	Dim dtmTargetDate 
	Dim objSourceFile 
	Dim dtmSourceDate 
	'Set objFso = WScript.CreateObject("Scripting.FileSystemObject") 
	Set objTargetFile = objFSO.GetFile(strTargetFile) 
	dtmTargetDate = objTargetFile.DateLastModified 
	Set objSourceFile = objFSO.GetFile(strSourceFile) 
	dtmSourceDate = objSourceFile.DateLastModified 
	If (dtmTargetDate < dtmSourceDate) Then 
		objFSO.CopyFile objSourceFile.Path, objTargetFile.Path, OverwriteExisting
	End If 
'	WScript.Echo ""
'	Wscript.Echo objFile.Name
'	Wscript.Echo "Date created: " & objFile.DateCreated
'	Wscript.Echo "Date last accessed: " & objFile.DateLastAccessed
'	Wscript.Echo "Date last modified: " & objFile.DateLastModified
'	Wscript.Echo "Drive: " & objFile.Drive
'	Wscript.Echo "Name: " & objFile.Name
'	Wscript.Echo "Parent folder: " & objFile.ParentFolder
'	Wscript.Echo "Path: " & objFile.Path
'	Wscript.Echo "Short name: " & objFile.ShortName
'	Wscript.Echo "Short path: " & objFile.ShortPath
'	Wscript.Echo "Size: " & objFile.Size
'	Wscript.Echo "Type: " & objFile.Type 

End Sub

Sub DeleteSubkeys(HKEY_LOCAL_MACHINE, strKeyPath) 
    oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubkeys 

	'=== Usage DeleteSubkeys HKEY_CURRENT_USER, strKeypath 

    If IsArray(arrSubkeys) Then 
        For Each strSubkey In arrSubkeys 
            DeleteSubkeys HKEY_LOCAL_MACHINE, strKeyPath & "\" & strSubkey 
        Next 
    End If 

    oReg.DeleteKey HKEY_LOCAL_MACHINE, strKeyPath 
End Sub

Function Q(s)
  Q = """" & s & """"
End Function

' -----------------------------------------------------
' ---- Sub RunHere(theCommandLine, theWorkingDirectory)
' -----------------------------------------------------
 
Sub RunHere(theCommandLine, theWorkingDirectory)
 
    Const WAIT = True
 
    Dim objSh, strPopd
 
    On Error Resume Next
    Set objSh = WScript.CreateObject("WScript.Shell")
    strPopd = objSh.CurrentDirectory
    objSh.CurrentDirectory = theWorkingDirectory
    objSh.Run theCommandLine, , WAIT
    objSh.CurrentDirectory = strPopd
    Set objSh = Nothing
    On Error GoTo 0
 
End Sub

Open in new window

0
 
LVL 9

Expert Comment

by:skipper68
ID: 40566592
Unfortunately, I'm not able to recreate your issue.  When I run the following the first time, it creates a folder.  When I run it again, it doesn't create the folder.  Run this twice to see if you get errors with this stripped down version.
Set wshShell = CreateObject( "WScript.Shell" )
Set objFSO = CreateObject("Scripting.FileSystemObject")

strMenu = "C:\"
'Create folder to place shortcuts
	If Not objFSO.FolderExists (strMenu & "\Medassurant\") Then
		msgbox "Create Folder"
		objFSO.CreateFolder strMenu & "\Medassurant\"
	Else
		msgbox "Folder Already Exists"
	End If

Open in new window

0
 
LVL 9

Accepted Solution

by:
skipper68 earned 250 total points
ID: 40566599
As I mentioned, you're looking for a folder in one location and creating it in another.  It's never going to exist in the first location if you're creating it somewhere else...

You're looking here: C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Medassurant
And creating it here: strStartMenu & "\Medassurant\"

I'd either use the variable in the IF statement, or use the full path in the second.
0
 
LVL 35

Expert Comment

by:Kimputer
ID: 40566600
I'm only one line off (line 129 vs your error on line 128,2) but I'm assuming I mean the same as the script error return number does.
The answer therefore still stands. You create a folder that is already there and the script will stop.

The whole point of line 128 is:

If Not objFSO.FolderExists ("C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Medassurant") Then
	objFSO.CreateFolder strStartMenu & "\Medassurant\"
	End If

Open in new window


Check if folder exist, if NOT exist, Create it.

What you didn't see is that you are checking one thing and creating another. That MAKES NO SENSE.
My first solution gave you TWO solutions, BOTH of which you didn't look at in detail, nor did you read the explanation (as you have two experts repeating themselves now).
0
 

Author Comment

by:xzay1967
ID: 40566851
My apologies to both of you. I went ahead and tried the first suggestion you (Kimputer) posted. I relooked and realized I made an oversight the first time I looked at it.  Both of you posted solutions so I am going to award both of you points. Thanks.
0

Featured Post

Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

Join & Write a Comment

This is an addendum to the following article: Acitve Directory based Outlook Signature (http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_24950055.html) The script is fine, and works in normal client-server domains…
This script will sweep a range of IP addresses (class c only, 255.255.255.0) and report to a log the version of office installed. What it does: 1.)      Creates log file in the directory the script is run from (if it doesn't already exist) 2.)      Sweep…
This video discusses moving either the default database or any database to a new volume.
You have products, that come in variants and want to set different prices for them? Watch this micro tutorial that describes how to configure prices for Magento super attributes. Assigning simple products to configurable: We assigned simple products…

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now