Vbs Brows For Question

[gunsmokingman]

This Code Work OK, Except For Two Problem

It Will Not Do This

SOME-HD:\SomeApp.exe

But It Will Do This

SOME-HD:\SomeFolder\SomeApp.exe

It Will Not Do This

SOME-HD:\Some Folder\Some App.exe

But It Will Do This

SOME-HD:\Some Folder\SomeApp.exe

I would like to be able to do the blue highlighted one.

Dim sh, fol, fs, lngView, strPath
Set Shell = WScript.CreateObject("WScript.Shell")
Set sh = CreateObject("Shell.Application")
Set fs = CreateObject("Scripting.FileSystemObject")
V = Vbcrlf
FUNCTION RT
strPrompt="This Will Open Only Folder Listed In A Root Drive. It Will Not Open Just The Root Drive!" & space(2) &_
"Root=Any HD Or Partition" & space(5) & "Eg> Root:\" & space(2) & "Wrong" & space(5) & "EG1>Root:\SomeFolder" & space(2) & "Right"
strTitle ="Gsm Open A Folder"
RT = BrowseForFile(strPrompt, strTitle )
End Function
Function GsmGetApp02 
Gsm02=RT
MsgBox Gsm02
'GsmGetApp02 = (CreateObject("Wscript.shell").run (Chr(34) & "" & Gsm02 & "\spybotsd13.exe /silent"& Chr(34)))
GsmGetApp02 = (CreateObject("Wscript.shell").run (Chr(34) & "" & Gsm02 & "\"& Chr(34)))
End Function 
Function BrowseForFile(strPrompt, strTitle )
On Error Resume Next
If Instr(TypeName(CreateObject("Shell.Application")), "Shell") = FALSE Then
ELSE
BrowseForFile = BrowseForFile_Shell(strPrompt)
End If
End Function
Function BrowseForFile_Shell(strPrompt)
lngView = SFVVO_SHOWALLOBJECTS Or SFVVO_SHOWEXTENSIONS Or SFVVO_SHOWFILES Or SFVVO_SHOWDRIVE
strPath = ""
Set fol = sh.BrowseForFolder(&0, strPrompt, lngView, ssfDRIVES)
On Error Resume Next
strPath = fol.ParentFolder.ParseName(fol.Title).Path
If strPath = ("*\(*:)") Then 
strPath = fol.Title
Set fol = fol.ParentFolder
strPath = fs.BuildPath("", strPath)
End If
BrowseForFile_Shell = strPath
End Function

GsmGetApp02

I Have Tried A Couble Of Different Ways On Trying To

Get It Like The Blue highlighted Ones But No Luck.

Thanks for any help

[dman]

It seems to work OK. I renamed "spybotsd.exe" to "spy botsd.exe" and it works. there is no spybotsd13.exe file in the folder. Is this code just a test, or is that file actually there on your computer? What is the "xxx yyy.exe" file you are trying to run?

Dim sh, fol, fs, lngView, strPath
Set Shell = WScript.CreateObject("WScript.Shell")
Set sh = CreateObject("Shell.Application")
Set fs = CreateObject("Scripting.FileSystemObject")
V = Vbcrlf
FUNCTION RT
strPrompt="This Will Open Only Folder Listed In A Root Drive. It Will Not Open Just The Root Drive!" & space(2) &_
"Root=Any HD Or Partition" & space(5) & "Eg> Root:\" & space(2) & "Wrong" & space(5) & "EG1>Root:\SomeFolder" & space(2) & "Right"
strTitle ="Gsm Open A Folder"
RT = BrowseForFile(strPrompt, strTitle )
End Function
Function GsmGetApp02
Gsm02=RT
MsgBox Gsm02
GsmGetApp02 = (CreateObject("Wscript.shell").run (Chr(34) & "" & Gsm02 & "\spy botsd.exe"& Chr(34)))
'GsmGetApp02 = (CreateObject("Wscript.shell").run (Chr(34) & "" & Gsm02 & "\"& Chr(34)))
End Function
Function BrowseForFile(strPrompt, strTitle )
On Error Resume Next
If Instr(TypeName(CreateObject("Shell.Application")), "Shell") = FALSE Then
ELSE
BrowseForFile = BrowseForFile_Shell(strPrompt)
End If
End Function
Function BrowseForFile_Shell(strPrompt)
lngView = SFVVO_SHOWALLOBJECTS Or SFVVO_SHOWEXTENSIONS Or SFVVO_SHOWFILES Or SFVVO_SHOWDRIVE
strPath = ""
Set fol = sh.BrowseForFolder(&0, strPrompt, lngView, ssfDRIVES)
On Error Resume Next
strPath = fol.ParentFolder.ParseName(fol.Title).Path
If strPath = ("*\(*:)") Then
strPath = fol.Title
Set fol = fol.ParentFolder
strPath = fs.BuildPath("", strPath)
End If
BrowseForFile_Shell = strPath
End Function

GsmGetApp02

[gunsmokingman]

This Is The problem hope this explains it better

Thanks For Your Reply This Is A Template Of A Script

So The Main Thing Is I want to be able to pass the varible

from C:\ D:\ etc, and also to be able to handle double spaces

[dman]

I found some stuff about wscript and file names with spaces. The suggestion is to enclose the exe in brackets with qoutes Ex. ["some app.exe"]

http://www.foxite.com/archives/0000023492.htm

I'm still not sure exactly what you are trying to do. Do you really just want to return a folder name, or would it be better to return a file name and path?

If so you might want to try commondialog instead of shell.browseforfolder.

Dim shell, x
Set Shell = WScript.CreateObject("WScript.Shell")
Set ObjFSO = CreateObject("UserAccounts.CommonDialog") 
ObjFSO.Filter = "Programs|*.exe|Scripts|*.vbs" 
InitFSO = ObjFSO.ShowOpen
If InitFSO = False Then
    Wscript.Echo "You did not select a file!"
    Wscript.Quit
Else
    Wscript.Echo "You selected the file: " & ObjFSO.FileName
    x = shell.run (Chr(34) & ObjFSO.FileName & Chr(34))
End If

[gunsmokingman]

What Happen Is That If I go To

This Will Not Work

C:\Some.exe

C is only a Example

C:\

This Wont Run

BOOT000-0-1(C:)

This Is The varible If I Use My Script That get passed back To The script

If I Was To Go To C:\Folder

I get the correct varible passed back to my script.

Test Dir For Space

Varible Pass To Script

H:\Test Folder

Function GsmGetApp02 
Gsm02=RT
MsgBox Gsm02
GsmGetApp02 = (CreateObject("Wscript.shell").run (Chr(34) & "" & Gsm02 & "\UaKill Time.HTA "& Chr(34)))
End Function

The script works fine as it is I just want to take out those flaw with it.

Got The Space Issue To Work

Only Problem Is It Wont Open C:\ or D:\ Or E:\ etc

Thanks For Your Help

Edited February 18, 2005 by gunsmokingman

[dman]

I'm not too up on vbscript, so I'm not sure if there is a way to return just the drive letter, but you can always brute-force parse it. If the return is a root drive folder name, the return will always include the drive letter and end with "". This combo would be invalid in this position if you were returning a subfolder name, so you can detect this and parse out all but the drive letter and colon and you should be good.

Excerpt from BrowseForFile_Shell(strPrompt)

If Right(fol.Title, 2) = ":)" Then                      'must be a root drive
   strpath = Mid(fol.Title, len(fol.Title) - 2, 2)    
else                                                    'is a subfolder
   strPath = fol.ParentFolder.ParseName(fol.Title).Path
End If

[gunsmokingman]

Thank you that was the perfect code.

The script now passes the correct varible.

Final Code

It Will Open Any Folder Or Partition Now Correctly

Set Shell = WScript.CreateObject("WScript.Shell")
AP = Shell.ExpandEnvironmentStrings("%AllUsersProfile%")
UP = Shell.ExpandEnvironmentStrings("%UserProfile%")
SD = Shell.ExpandEnvironmentStrings("%SystemDrive%")
SP = Shell.ExpandEnvironmentStrings("%SystemDrive%\Program Files")
WD= Shell.ExpandEnvironmentStrings("%Windir%\")

FUNCTION RT
RT = BrowseForFile("Open A Folder Than Use Right Click Functions:" & Vbcrlf &_
"This Will Not Open Root Drives" & Vbcrlf & "Eg C:\ Will not Open  EG1 C:\SomeFolder Will Open" & vbcrlf & "Test Line 1","Select File")
End Function

Function GsmGetApp02 
Gsm02=RT
MsgBox Gsm02
GsmGetApp02 = (CreateObject("Wscript.shell").run (Chr(34) & "" & Gsm02 & ""& Chr(34)))
End Function 

Function BrowseForFile(strPrompt, strTitle )
On Error Resume Next
If Instr(TypeName(CreateObject("Shell.Application")), "Shell") = 0 Then
msgbox "Error Happen!"
ELSE
BrowseForFile = BrowseForFile_Shell(strPrompt)
End If
End Function
Function BrowseForFile_Shell(strPrompt)
Dim sh, fol, fs, lngView, strPath
Set sh = CreateObject("Shell.Application")
Set fs = CreateObject("Scripting.FileSystemObject")
lngView = SFVVO_SHOWALLOBJECTS Or SFVVO_SHOWEXTENSIONS Or SFVVO_SHOWFILES Or SFVVO_SHOWDRIVE
strPath = ""
'Set fol = sh.BrowseForFolder(&0, strPrompt, lngView, ssfDRIVES)

Set fol = sh.BrowseForFolder(&0, strPrompt, lngView)
'(["My App.exe"])

On Error Resume Next
strPath = fol.ParentFolder.ParseName(fol.Title).Path
If Right(fol.Title, 2) = ":)" Then                      'must be a root drive
  strpath = Mid(fol.Title, len(fol.Title) - 2, 2)    
else                                                    'is a subfolder
  strPath = fol.ParentFolder.ParseName(fol.Title).Path
End If
If strPath = "" Then
strPath = fol.Title
Set fol = fol.ParentFolder
strPath = fs.BuildPath("", strPath)
End If
BrowseForFile_Shell = strPath
End Function

GsmGetApp02

[dman]

Glad I could help

[gunsmokingman]

This Is What Your Code Help , Me With It MakeCab.vbs

It Will MakeCab And Than A Folder Than Delete The Source

And Leave A Expand.cmd For Later use.

Thanks Again For Your Help

 on error resume next
  Dim Shell, SD, fso, sh, fs, objFSO, V ,WD, RT 
  V = Vbcrlf
    Set Shell = WScript.CreateObject("WScript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set sh = CreateObject("WScript.Shell")
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    SD = Shell.ExpandEnvironmentStrings("%SystemDrive%")
     

       RT = BrowseForFile("Open A Folder Than Use Right Click Functions:", "Select File")
    Function BrowseForFile(strPrompt, strTitle)
    
    On Error Resume Next
    If Instr(TypeName(CreateObject("Shell.Application")), "Shell") = 0 Then
      BrowseForFile = InputBox(strPrompt, strTitle, WScript.ScriptFullName,"HELLO")
    Else
      BrowseForFile = BrowseForFile_Shell(strPrompt)
    End If
    End Function
    Function BrowseForFile_Shell(strPrompt)
    Dim sh, fol, fs, lngView, strPath
        Set sh = CreateObject("Shell.Application")
        Set fs = CreateObject("Scripting.FileSystemObject")
        lngView = SFVVO_SHOWALLOBJECTS Or SFVVO_SHOWEXTENSIONS Or SFVVO_SHOWFILES
        strPath = ""
        Set fol = sh.BrowseForFolder(&0, strPrompt, lngView, ssfDRIVES)
    On Error Resume Next
 strPath = fol.ParentFolder.ParseName(fol.Title).Path
    If Right(fol.Title, 2) = ":)" Then                      'must be a root drive
 strpath = Mid(fol.Title, len(fol.Title) - 2, 2)    
    else                                                    'is a subfolder
 strPath = fol.ParentFolder.ParseName(fol.Title).Path
    End If
    If strPath = "" Then
        strPath = fol.Title
    Set fol = fol.ParentFolder
        strPath = fs.BuildPath(fol.ParentFolder.ParseName(fol.Title).Path, strPath)
    End If
    BrowseForFile_Shell = strPath
    End Function
    '''''''FUNCTION THIS OPEN THE BROWS FOR DIALOG
    Gsm02=Rt
    MsgBox Gsm02
    '''''''FUNCTION THIS OPEN THE BROWS FOR DIALOG  
    Set f = fso.CreateFolder(SD & "\TEMP")
  Gsm = Msgbox (space(7) & "Preparing MakecaB Process" & V & "This Will MakecaB The Directory" & V & Gsm02 & V &_
  "Yes Will Begin The Process" & V & "No Will Quit And Do Nothing", 4 + 48, "Please Read This")
    if Gsm = vbyes Then
    On Error Goto 0
  Ed = msgbox ("Here The Location:" & V & Gsm02 , 0 +64,"Here What You Choosed")
  wscript.sleep 1200
    Set ts = fs.OpenTextFile(Rt & "\MKdel.cmd", 2, True)
     ts.WriteLine "echo off && Cls && Color 9f && Mode Con: Cols=70 Lines=9"  
     ts.WriteLine "set RT=" & Gsm02 
     ts.WriteLine "ping -n 1 127.0.0.1>nul"
     ts.WriteLine "Title MakecaB IN :-^>" & Gsm02
     'ts.WriteLine "for %%i in (%RT%\*.*) do makecab /D CompressionType=LZX /D CompressionMemory=21 %1 %2 %%i && move %RT%\*.*_ %systemdrive%\Temp\"
     ts.WriteLine "for %%i in (""%RT%\*.*"") do makecab /D CompressionType=LZX /D CompressionMemory=21 %1 %2 ""%%i"" && move *.*_ %systemdrive%\Temp\"     
     ts.Close
     wscript.sleep 500 
     msgbox  space(7) & "Preparing To Run The Cmd" & V & "In This Location: "  & Gsm02 ,0+48,"Beginning MakeCaB"
     wscript.sleep 500
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set oWS = WScript.CreateObject("WScript.Shell")
    'CreateObject("WScript.Shell").Run(Gsm02 & "\MKdel.cmd")
    CreateObject("WScript.Shell").Run( Chr(34) & Gsm02 & "\MKdel.cmd" & Chr(34))
  wscript.sleep 3000
  msgbox "When The Cmd Window Closes" & V & "Press Button To Continue", 0 + 64, "Waiting For MakacaB"
    On Error Resume Next
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set fso = CreateObject("Scripting.FileSystemObject")
    set objShell = CreateObject("Shell.Application")
    set objFolder = objShell.NameSpace(SD & "\TEMP")
  Wscript.sleep 2000
    if not objFolder is nothing then
  objFolder.MoveHere(SD & "\*.*_")
    'Set f = fso.CreateFolder(RT & "\Archive\")
  fso.Deletefile( SD & "\*.*_")
    ON ERROR RESUME NEXT
    Set fso = CreateObject("Scripting.FileSystemObject")
  fso.DeleteFile( RT & "\*.*")
  wscript.sleep 3000   
  MSGBOX space(7) & "Phase One Completed" & V & "Preparing For Phase Two", 0 + 64, "Preparing Phase Two"
    set objFolder = objShell.NameSpace(Gsm02 & "\")
  objFolder.MoveHere(SD & "\TEMP\*.*_")
  wscript.sleep 3000
  MSGBOX space(7) & "Preparing Final Phase" & space(7) & V & "This Will Leave A Expand Cmd" & V &_
  "In : " & RT & V & " Name Of The Cmd Is : ExpandArch.cmd", 0 + 64, "Phase Two"
    Set fs = CreateObject("Scripting.FileSystemObject")  
    Set ED = fs.OpenTextFile(RT & "\ExpandArch.cmd", 2, True)
     ED.WriteLine "ECHO OFF && cls && color f2 && mode 69,9"  
     ED.WriteLine "Title EXPAND Archive "
     ED.WriteLine "set RT=%CD%"
     ED.WriteLine "mkdir ""%RT%\Archive"""
     ED.WriteLine "for %%i in (""%RT%\*.*"") do EXPAND *.*_ /R && Move *.*_ ""%RT%\Archive"" && ping -n 1 127.0.0.1>nul"
     ED.WriteLine "ping -n 1 127.0.0.1>nul"
     ED.WriteLine "Cls && mode 55,5 && Color 9f && Echo. && Echo Would You Like To Keep The Archive?"
     ED.WriteLine "Echo Yes To Keep Archive   No To Delete Archive"
     ED.WriteLine "Set /P Choice=Yes To Keep No To Delete :-^> "
     ED.WriteLine "Goto %Choice%"
     ED.WriteLine ":NO && Cls && Title Remove %RT%\Archive"
     ED.WriteLine "del /s /q ""%RT%\Archive\*.*_"""
     ED.WriteLine "ping -n 1 127.0.0.1>nul"     
     ED.WriteLine "Rmdir /s /q " & Chr(34) & "%RT%\Archive" & chr(34)
     ED.WriteLine "ping -n 1 127.0.0.1>nul"     
     ED.WriteLine "Echo. && Echo %RT%\Archive && Echo Removed && Ping -3 127.0.0.0.1>nul && Goto Quit"
     ED.WriteLine ":Yes && Cls && Title Keeping %RT%\Archive"
     ED.WriteLine "Echo. && Echo keeping && Echo %RT%\Archive && Ping -3 127.0.0.0.1>nul && Goto Quit"
     ED.WriteLine ":Quit && Echo Goodbye && ping -n 3 127.0.0.1>nul && exit"
     ED.Close
  wscript.sleep 500 
            ON ERROR RESUME NEXT
    Set fso = CreateObject("Scripting.FileSystemObject")
  fso.Deletefolder( SD & "\TEMP")
  Wscript.sleep 1000
    end if
    set objShell = nothing
    set objFolder = nothing
  MsgBox "Completed Archive Process" & V & " Thank-You For Trying This" & V & "Gunsmokingman", 0 + 64 ,"Gsm Says Good Bye"
     Set fso = CreateObject("Scripting.FileSystemObject")
     on Error Resume Next
     fso.DeleteFile( Chr(34) &  Gsm02 & "\MKdel.cmd" & chr(34))
     fso.DeleteFile( SD & "\GmanMkcaB.vbs")
     set fso = nothing

    else
    end if 
    if Gsm = vbno Then
    On Error Resume Next
    msgbox "Preparing To Quit" & V & "Cleaning Up Files Made", 0 + 64, "Gsm Says Good-Bye"
     Set fso = CreateObject("Scripting.FileSystemObject")
     fso.Deletefolder( SD & "\TEMP")
     fso.DeleteFile( Gsm02 & "\MKdel.cmd")
     fso.DeleteFile( SD & "\GmanMkcaB.vbs")
else
end if

Edited January 5, 2006 by gunsmokingman

[dman]

Nice work, Gman!

Your code runs great. I learn a few things from you, too.

[gunsmokingman]

I Just Ran This Code You Posted And I Am,

Dim shell, x
Set Shell = WScript.CreateObject("WScript.Shell")
Set ObjFSO = CreateObject("UserAccounts.CommonDialog") 
ObjFSO.Filter = "Programs|*.exe|Scripts|*.vbs" 
InitFSO = ObjFSO.ShowOpen
If InitFSO = False Then
   Wscript.Echo "You did not select a file!"
   Wscript.Quit
Else
   Wscript.Echo "You selected the file: " & ObjFSO.FileName
   x = shell.run (Chr(34) & ObjFSO.FileName & Chr(34))
End If

Going To Use It In My Next Script

Dim shell, X1, X2, X3
Set Shell = WScript.CreateObject("WScript.Shell")
Set ObjFSO = CreateObject("UserAccounts.CommonDialog") 

function recall
X2=ObjFSO.FileName
MsgBox X2, 0 + 64,"Recall Varible"
end function

function NotThere
X3="No File Was Selected" & Vbcrlf & "Preparing To Quit" 
MsgBox X3, 0 + 64,"Exiting Script"
end function

Function GsmGetFile
ObjFSO.Filter = "All Files|*.*" 
InitFSO = ObjFSO.ShowOpen
If InitFSO = False Then
   NotThere
   Wscript.Quit
Else
   X2=ObjFSO.FileName
   recall
   X1 = shell.run (Chr(34) & ObjFSO.FileName & Chr(34))
   
   Set Shell = nothing
   Set ObjFSO = nothing
End If
End Function

GsmGetFile

Thanks Again Ill also use the above Code In some Other Scripts

That A Nice Little Piece Of Code There.

Edited February 19, 2005 by gunsmokingman