[Iska]

Пробуйте (по понятным причинам — не проверялось):

Скрытый текст

Код:

Option Explicit

Dim strPath2TrueCrypt
Dim strDriveLetter

Dim strPath2App


With WScript.CreateObject("Scripting.FileSystemObject")
	strPath2TrueCrypt = .BuildPath(WScript.CreateObject("Shell.Application").NameSpace("shell:ProgramFiles").self.Path, "TrueCrypt\TrueCrypt.exe")
	
	If .FileExists(strPath2TrueCrypt) Then
		strDriveLetter = Left(WScript.ScriptName, 1) & ":"
		
		If Not .DriveExists(strDriveLetter) Then
			WScript.CreateObject("WScript.Shell").Run """" & strPath2TrueCrypt & """ /letter " & strDriveLetter & " /auto devices /history n /cache n /mountoption removable /mountoption timestamp /quit", 1, True
			
			Select Case MsgBox("Yes:    start «Dexpot»" & vbLf & "No:     start «Total Commander»" & vbLf & "Cancel: nothing start", vbInformation + vbYesNoCancel, "Start application")
				Case vbYes
					strPath2App = .BuildPath(strDriveLetter, "sOft\Dexpot\Dexpot.exe")
					
					If .FileExists(strPath2App) Then
						WScript.CreateObject("WScript.Shell").Run """" & strPath2App & """", 1, False
					Else
						WScript.Echo "Can't find [" & strPath2App & "]."
						WScript.Quit 2
					End If
				Case vbNo
					strPath2App = .BuildPath(strDriveLetter, "sOft\TotalCommander\TOTALCMD.EXE")
					
					If .FileExists(strPath2App) Then
						WScript.CreateObject("WScript.Shell").Run """" & strPath2App & """", 1, False
					Else
						WScript.Echo "Can't find [" & strPath2App & "]."
						WScript.Quit 2
					End If
				Case vbCancel
					' Nothing to do
			End Select
		Else
			WScript.CreateObject("WScript.Shell").Run """" & strPath2TrueCrypt & """ /dismount " & strDriveLetter & " /wipecache /silent /quit", 1, True
		End If
	Else
		WScript.Echo "Can't find [" & strPath2TrueCrypt & "]."
		WScript.Quit 1
	End If
End With

WScript.Quit 0

Снятие процесса приложения виртуальных рабочих столов делать не стал. Проверку на то, что первый символ скрипта — буква, тоже не делал.