I am looking for a VBS browse function which gets the shortcut path. Unfortunately all browse functions I tried got only the folder path, but not shortcut path. I can see the shortcut in the dialog, but cannot get the path of it.
Is there someone who has this kind of function?
strComputer = "."
Const ALL_OPTIONS = &H4000
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder (0, "Select a folder:",ALL_OPTIONS,(16))
If objFolder Is Nothing Then
Wscript.Quit
Else
Set objFolderItem = objFolder.Self
End If
objPath = objFolderItem.Path
This function gives a real folder path, but when I select a shortcut with it, it returns null.
How can I get the shortcut path with browse for folder function?
Use the .ShortPath property of the file or folder object:
Option Explicit
Dim goFS : Set goFS = CreateObject("Scripting.FileSystemObject")
Dim f
Set f = goFS.GetFolder(".") : WScript.Echo f.Path, f.ShortPath
Set f = goFS.GetFile(WScript.ScriptFullName) : WScript.Echo f.Path, f.ShortPath
output:
cscript //nologo "45388073-pi pa po.vbs"
C:\Users\eh\work C:\Users\eh\work
C:\Users\eh\work\45388073-pi pa po.vbs C:\Users\eh\work\453880~1.VBS
Update wrt comment:
given:
objPath = objFolderItem.Path ' it's a string not an object!
sShortPath, and goFS, do:
sShortPath = goFS.GetFolder(objPath).ShortPath
Related
In continuation of Call VBScript from Windows Explorer Context Menu, I managed to get a VBScript file running from SendTo in the Windows Explorer.
I've changed my code to copy the file that invokes the script to my Temp folder. The new problem is that if the path is over 256 characters, I can't loop through WScript.Arguments to get all of it. Is there another way to get the full path (including the file name and it's extension)?
Option Explicit
Call OpenDocuWorksFile
Sub OpenDocuWorksFile()
Const sTitle = "Open DocuWorks File"
Dim iArgumentsCount
Dim iArgument
Dim sFilePath
Dim sTempFolder
Dim oFileScriptingObject
Dim sFileName
Dim oShell
iArgumentsCount = WScript.Arguments.Count
On Error Resume Next
For iArgument = 0 To iArgumentsCount
sFilePath = sFilePath & WScript.Arguments(iArgument)
Next
On Error GoTo 0
Set oFileScriptingObject = CreateObject("Scripting.FileSystemObject")
With oFileScriptingObject
sFileName = .GetFileName(sFilePath)
sTempFolder = oFileScriptingObject.GetSpecialFolder(2) 'Temp Folder
If .GetExtensionName(sFileName) = "xdw" Then
.CopyFile sFilePath, sTempFolder & "\", True 'Overwrite
Set oShell = CreateObject("Shell.Application")
oShell.Open sTempFolder & "\" & sFileName
Else
MsgBox "Please select a DocuWorks file.（.xdw)", vbCritical, sTitle
End If
End With
Set oFileScriptingObject = Nothing
Set oShell = Nothing
End Sub
I am trying to check to see if a network location shortcut is in my Network Shortcut if it exist delete it and make another one called homedrive. How ever it makes the homedrive but doesnt delete the old one. the old one is registered by username hense why i used %username%. i just need help with the deleting
Thank You in Advance
Const NETHOOD = &H13&
Set objWSHShell = CreateObject("Wscript.Shell")
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(NETHOOD)
Set objFolderItem = objFolder.Self
strNetHood = objFolderItem.Path
Set Shell = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Networkpath = Shell.SpecialFolders("NETHOOD")
shortcut = Networkpath & "\%username%.lnk"
If FSO.FileExists(shortcut) Then
FSO.DeleteFile shortcut
End If
strShortcutName = "HomeDrive"
strShortcutPath = "\\homer-2\IT$\%username%"
Set objShortcut = objWSHShell.CreateShortcut _
(strNetHood & "\" & strShortcutName & ".lnk")
objShortcut.TargetPath = strShortcutPath
objShortcut.Save
This
>> Set Shell = CreateObject("WScript.Shell")
>> Set FSO = CreateObject("Scripting.FileSystemObject")
>> sFSpec = FSO.BuildPath("%HOME%", "tmp.txt")
>> WScript.Echo CStr(FSO.FileExists(sFSpec)), sFSpec
>> sFSpec = Shell.ExpandEnvironmentStrings(sFSpec)
>> WScript.Echo CStr(FSO.FileExists(sFSpec)), sFSpec
>>
False %HOME%\tmp.txt
True C:\Documents and Settings\eh\tmp.txt
>>
proves that the FSO does not expand environment variables automagically. So
shortcut = Networkpath & "\%username%.lnk"
If FSO.FileExists(shortcut) Then
will never be true. Use Shell.ExpandEnvironmentStrings().
I want to create a custom button on my Windows Explorer toolbar to create a new blank text document, similar to the "New Folder" button that is already there.
Following these steps, I was able to create my button and get it running a custom VBScript:
Set WshShell = WScript.CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFile = fso.CreateTextFile(WshShell.CurrentDirectory & "\NewTextDocument.txt", True)
objFile.Close
Wscript.Quit
However, the value of WshShell.CurrentDirectory is C:\Windows\system32. (I think this is because the command being called is wscript.exe which is in that directory.).
How can I get the directory where the Explorer window is opened up to?
--
Somewhat related: I have been getting a "Permission denied" error when I run this script. I was assuming this was because the system32 directory is protected. Are there any other precautions to ensure the script will be allowed to create a file?
Thanks.
You need a different approach.
Use the shell not file system to do what you want.
Here's two sample scripts using the type of objects you need.
'Const NETHOOD = &H14& 'fonts
'Const NETHOOD = &H12& 'Network
Const NETHOOD = &H11& 'My Comp
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(NETHOOD)
Set objFolderItem = objFolder.Self
Wscript.Echo objFolderItem.Path
Set colItems = objFolder.Items
For Each objItem in colItems
For x = 1 to 79
Properties = Properties & vbtab & objFolder.GetDetailsOf(ObjItem, x)
Next
Wscript.Echo objItem.Name" & Properties
Properties=""
Next
and to find right window
Set objShell = CreateObject("Shell.Application")
Set AllWindows = objShell.Windows
For Each window in AllWindows
msgbox window.locationname
Next
Using the following code that I pulled from the web, I'm able to do a search in a single directory for excel files containing a string in a certain row. How would I allow this to be recursive in all the subfolders as well? I've found a few answers but I just don't understand how I would implement them in my code. I only started messing with VBScript yesterday and I'm pretty confused about how to make this work.
strComputer = "CAA-W74109188"
Set objExcel = CreateObject("Excel.Application", strComputer)
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set FileList = objWMIService.ExecQuery _
("ASSOCIATORS OF {Win32_Directory.Name='c:\TDRS'} Where " _
& "ResultClass = CIM_DataFile")
For Each objFile In FileList
If (objFile.Extension = "xlsm" or objFile.Extension = "xls") Then
Set objWorkbook = objExcel.Workbooks.Open(objFile.Name)
Set objWorksheet = objWorkbook.Worksheets(1)
If objExcel.Cells(3,10) = "Complete" or objExcel.Cells(3,9) = "Released" Then
Wscript.Echo objFile.FileName
End If
objExcel.DisplayAlerts = False
objworkbook.Saved = False
objWorkbook.Close False
End If
Next
objExcel.Quit
Here is an script that I used to delete files with, which I have modified for your needs. A recursive function is what you need to get the job done and I have always found them to be interesting and kind of hard to wrap my head around.
Dim Shell : Set Shell = WScript.CreateObject( "WScript.Shell" )
Dim oFSO : Set oFSO = CreateObject("Scripting.FileSystemObject")
Dim objExcel : Set objExcel = CreateObject("Excel.Application")
Dim Paths(0)
Paths(0) = "c:\temp"
For Each Path in Paths
FolderScan(Path)
Next
Sub FolderScan(Folder)
Set base = oFSO.GetFolder(Folder)
If base.SubFolders.Count Then
For Each folder in Base.SubFolders
FolderScan(folder.Path)
Next
End If
Set files = base.Files
If files.Count Then
For Each File in files
If LCase(oFSO.GetExtensionName(File.Path) = "xlsm") or _
LCase(oFSO.GetExtensionName(File.Path) = "xls") Then
Dim objWorkbook : Set objWorkbook = objExcel.Workbooks.Open(File.Path)
Dim objWorkSheet : Set objWorkSheet = objWorkbook.Worksheets(1)
If (objExcel.Cells(3,10) = "Complete" or _
objExcel.Cells(3,9) = "Released") Then
Wscript.echo File.Path
End if
objExcel.DisplayAlerts = False
objExcel.Quit
End If
Next
End If
End Sub
Here's a generic, recursive function that iterates all files and subfolders of a given folder object.
Dim FileSystem
Set FileSystem = CreateObject("Scripting.FileSystemObject")
DoFolder FileSystem.GetFolder("c:\somefolder")
Sub DoFolder(Folder)
Dim SubFolder
For Each SubFolder In Folder.SubFolders
DoFolder SubFolder
Next
Dim File
For Each File In Folder.Files
' Operate on each file
Next
End Sub
Currently this is my script
Set oWS = WScript.CreateObject("WScript.Shell")
' Get the %userprofile% in a variable, or else it won't be recognized
userProfile = oWS.ExpandEnvironmentStrings( "%userprofile%" )
What I am trying to do is grab the current user logged in, I want it to check the directory D:\"personsuser"\Appdata\Roaming\Local to see if the folder "Local" is created, if it isn't created I want to create one via createobject in vbs. The script above from what i know grabs the current logged on user, however i'm not sure how to use this variable to create a folder.
I know i will have to incorporate something along these lines:
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.CreateFolder("C:\FSO")
And or something along these lines:
Dim objNetwork
Dim userName
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objNetwork = CreateObject("WScript.Network")
userName = objNetwork.userName
If fso.driveExists("D:\" & userName & "\AppData\Local\") Then
FSO.CreateDirectory ("D:\" & userName & "\AppData\Local\")
End If
Thanks in advance, not very familiar with VBS however that is the only platform I can operate from in the environment that i'm using it.
Set oWS = WScript.CreateObject("WScript.Shell")
' Get the %userprofile% in a variable, or else it won't be recognized
userProfile = oWS.ExpandEnvironmentStrings( "%userprofile%" )
Dim objNetwork
Dim userName
Dim FSO
Dim Folder
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objNetwork = CreateObject("WScript.Network")
userName = objNetwork.userName
If NOT (FSO.FolderExists(userProfile + "\AppData\Roaming\Local")) Then
' Delete this if you don't want the MsgBox to show
MsgBox("Local folder doesn't exists, creating...")
splitString = Split(userProfile, "\")
' Create folder
MsgBox("D:\" + splitString(2) + "\AppData\Roaming\Local")
'FSO.CreateFolder(splitString(2) + "\AppData\Roaming\Local")
End If
Here you go man, this should work perfect, regards Daniel.
Here is code part from my utilty for FSO:
dim ffso
Function GetFSO
if not IsValidObject(ffso) then set ffso = CreateObject("Scripting.FileSystemObject")
Set GetFSO = ffso
End Function
sub SureDirectoryExists(ADir)
if ADir="" then exit sub
if not GetFSO().FolderExists(ADir) then
SureDirectoryExists ffso.GetParentFolderName(ADir)
ffso.CreateFolder ADir
end if
end sub
This function will create all folders in the path parameter (string).
Public Function CheckCreateFolder(path)
Dim TempPath As String
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
pos = 0
While pos < Len(path)
pos = InStr(pos + 1, path, "\")
TempPath = Left(path, pos)
If Not (FSO.FolderExists(TempPath)) Then
FSO.CreateFolder (TempPath)
End If
Wend
End Function