Background
I'm trying to automate the creation of Virtual Directories based on the location of an existing Virtual Directory and its sub-directories.
Example:
C:\WebSites\Parent\NewVirtualDirectories
Where Parent is a Virtual Directory and NewVirtualDirectories contains any automated Virtual Directories.
Problem
Using the following Code:
Option Explicit
Dim args, strComputer, strVdirName, strVdirPath, objVdir, objIIS, objWebSite
Set args = WScript.Arguments
strComputer = "localhost"
strVdirName = args(1)
strVdirPath = args(0)
Set objIIS = GetObject("IIS://" & strComputer & "/W3SVC/1")
Set objWebSite = objIIS.GetObject("IISWebVirtualDir","Root/Parent")
Set objVdir = objWebSite.Create("IISWebVirtualDir",strVdirName)
objVdir.AccessRead = True
objVdir.Path = strVdirPath
objVdir.AppCreate (True)
objVdir.SetInfo
WScript.Quit
I can create children under Parent, but they show up Directly under the parent. I need them to be in the Sub Folder.
I get: http://localhost/Parent/NewSite
I want: http://localhost/Parent/NewVirtualDirectories/NewSite
I've tried
Set objWebSite = objIIS.GetObject("IISWebVirtualDir","Root/Parent/NewVirtualDirectories")
but NewVirtualDirectories is not a Virtual Directory (an I don't want it to be) so I get an error. I can get the desired effect when I do this manually in IIS manager, but I can't figure out how to automate it.
Any help would be greatly appreciated.
EDIT
For those who are facing similar problems, I found a great resource for VBScript-ing
http://www.cruto.com/resources/vbscript/vbscript-examples/vbscript-sitemap.asp
After doing a lot more digging (trial and error) I was able to figure it out.
By referencing the existing folder as a IISWebDirectory, I was able to select it and then create an application without creating a virtual directory.
Option Explicit
Dim args, strComputer, strVdirName, strVdirPath, objVdir, objIIS, objWebSite
Set args = WScript.Arguments
strComputer = "localhost"
strVdirName = args(1)
strVdirPath = args(0)
Set objIIS = GetObject("IIS://" & strComputer & "/W3SVC/1")
Set objVdir = objIIS.GetObject("IISWebDirectory","Root/Parent/NewVirtualDirectories/" + strVdirName)
objVdir.AccessRead = True
objVdir.AccessScript = True
objVdir.AppFriendlyName = strVdirName
objVdir.AppCreate (True)
objVdir.SetInfo
WScript.Quit
Related
This has been bugging me for while as I feel I have few pieces of the puzzle but I cant put them all together
So my goal is to be able to search all .pdfs in a given location for a keyword or phrase within the content of the files, not the filename, and then use the results of the search to populate an excel spreadsheet.
Before we start, I know that this easy to do using the Acrobat Pro API, but my company are not going to pay for licences for everyone so that this one macro will work.
The windows file explorer search accepts advanced query syntax and will search inside the contents of files assuming that the correct ifilters are enabled. E.g. if you have a word document called doc1.docx and the text inside the document reads "blahblahblah", and you search for "blah" doc1.docx will appear as the result.
As far as I know, this cannot be acheived using the FileSystemObject, but if someone could confirm either way that would be really useful?
I have a simple code that opens an explorer window and searches for a string within the contents of all files in the given location. Once the search has completed I have an explorer window with all the files required listed. How do I take this list and populate an excel with the filenames of these files?
dim eSearch As String
eSearch = "explorer " & Chr$(34) & "search-ms://query=System.Generic.String:" & [search term here] & "&crumb=location:" & [Directory Here] & Chr$(34)
Call Shell (eSearch)
Assuming the location is indexed you can access the catalog directly with ADO (add a reference to Microsoft ActiveX Data Objects 2.x):
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sql As String
cn.Open "Provider=Search.CollatorDSO;Extended Properties='Application=Windows'"
sql = "SELECT System.ItemNameDisplay, System.ItemPathDisplay FROM SystemIndex WHERE SCOPE='file:C:\look\here' AND System.Kind <> 'folder' AND CONTAINS(System.FileName, '""*.PDF""') AND CONTAINS ('""find this text""')"
rs.Open sql, cn, adOpenForwardOnly, adLockReadOnly
If Not rs.EOF Then
Do While Not rs.EOF
Debug.Print "File: "; rs.Collect(0)
Debug.Print "Path: "; rs.Collect(1)
rs.MoveNext
Loop
End If
Try using the next function, please:
Function GetFilteredFiles(foldPath As String) As Collection
'If using a reference to `Microsoft Internet Controls (ShDocVW.dll)_____________________
'uncomment the next 2 lines and comment the following three (without any reference part)
'Dim ExpWin As SHDocVw.ShellWindows, CurrWin As SHDocVw.InternetExplorer
'Set ExpWin = New SHDocVw.ShellWindows
'_______________________________________________________________________________________
'Without any reference:_____________________________________
Dim ExpWin As Object, CurrWin As Object, objshell As Object
Set objshell = CreateObject("Shell.Application")
Set ExpWin = objshell.Windows
'___________________________________________________________
Dim Result As New Collection, oFolderItems As Object, i As Long
Dim CurrSelFile As String
For Each CurrWin In ExpWin
If Not CurrWin.Document Is Nothing Then
If Not CurrWin.Document.FocusedItem Is Nothing Then
If left(CurrWin.Document.FocusedItem.Path, _
InStrRev(CurrWin.Document.FocusedItem.Path, "\")) = foldPath Then
Set oFolderItems = CurrWin.Document.folder.Items
For i = 0 To oFolderItems.count
On Error Resume Next
If Err.Number <> 0 Then
Err.Clear: On Error GoTo 0
Else
Result.Add oFolderItems.item(CLng(i)).Name
On Error GoTo 0
End If
Next
End If
End If
End If
Next CurrWin
Set GetFilteredFiles = Result
End Function
Like it is, the function works without any reference...
The above function must be called after you executed the search query in your existing code. It can be called in the next (testing) way:
Sub testGetFilteredFiles()
Dim C As Collection, El As Variant
Set C = GetFilteredFiles("C:\Teste VBA Excel\")'use here the folder path you used for searching
For Each El In C
Debug.Print El
Next
End Sub
The above solution iterates between all IExplorer windows and return what is visible there (after filtering) for the folder you initially used to search.
You can manually test it, searching for something in a specific folder and then call the function with that specific folder path as argument ("\" backslash at the end...).
I've forgotten everything I ever knew about VBA, but recently stumbled across an easy way to execute Explorer searches using the Shell.Application COM object. My code is PowerShell, but the COM objects & methods are what's critical. Surely someone here can translate.
This has what I think are several advantages:
The query text is identical to what you wouold type in the Search Bar in Explorer, e.g.'Ext:pdf Content:compressor'
It's easily launched from code and results are easily extracted with code, but SearchResults window is available for visual inspection/review.
With looping & pauses, you can execute a series of searches in the same window.
I think this ability has been sitting there forever, but the MS documentation of the Document object & FilterView method make no mention of how they apply to File Explorer.
I hope others find this useful.
$FolderToSearch = 'c:\Path\To\Folder'
$SearchBoxText = 'ext:pdf Content:compressor'
$Shell = New-Object -ComObject shell.application
### Get handles of currenlty open Explorer Windows
$CurrentWindows = ( $Shell.Windows() | Where FullName -match 'explorer.exe$' ).HWND
$WinCount = $Shell.Windows().Count
$Shell.Open( $FolderToSearch )
Do { Sleep -m 50 } Until ( $Shell.Windows().Count -gt $WinCount )
$WindowToSerch = ( $Shell.Windows() | Where FullName -match 'explorer.exe$' ) | Where { $_.HWND -notIn $CurrentWindows }
$WindowToSearch.Document.FilterView( $SearchBoxText )
Do { Sleep -m 50 } Until ( $WindowToSearch.ReadyState -eq 4 )
### Fully-qualified name:
$FoundFiles = ( $WindowToSearch.Document.Folder.Items() ).Path
### or just the filename:
$FoundFiles = ( $WindowToSearch.Document.Folder.Items() ).Name
### $FoundFIles is an array of strings containing the names.
### The Excel portion I leave to you! :D
I am trying to create a VBA to download a google sheet into excel so I can compile stock market data daily. I would simply use power query for this but I am doing this on my personal laptop which is a mac and does not support power query. I am relatively new to coding so have been leaning on following online instructions. The instruction includes this:
Set objWebCon = CreateObject("MSXML2.XMLHTTP.3.0")
This line when ran creates an error message saying:
"
Run-time error '429':
ActiveX component can't create object
"
I think the issue lies within the fact that the instruction is based on a windows operating system. Any solution I've searched for is specific to windows operating systems.
Does anybody here know if I can change the "MSXML2.XMLHTTP.3.0" part of my code to fit it better to mac? Not sure if this is what needs to be done but any guidance would be super appreciated.
I attached my full code below but feel free to ignore it if not relavent. Thank you!!
Sub DownloadGoogleSheets()
Dim ShtUrl As String, Location As String, FileName As String
Dim objWebCon, objWrit As Object
'Sheet Url
ShtUrl = "https://docs.google.com/spreadsheets/d/1wpA_epxtlz96sxETqKttJwsy9Aubb15H8xslcSQ20T0/export?format=csv&id=1wpA_epxtlz96sxETqKttJwsy9Aubb15H8xslcSQ20T0" & gid = 1319327791
'Location
Location = ThisWorkbook.Path & "\" '/Users/[myName]/Desktop/Stock Analysis/n"
'FileName
FileName = "GoogleSheet.csv"
'Connection to Website
Set objWebCon = CreateObject("MSXML2.XMLHTTP.3.0")
'Writer
Set objWrit = CreateObject("ADODB.Stream")
'Connecting to the Website
objWebCon.Open "Get", ShtUrl, False
objWebCon.Send (ShtUrl)
'Once page is fully loaded
If objWebCon.Status = 200 Then
'Write the text of the sheet
objWrit.Open
objWrit.Type = 1
objWrit.Write objWebCon.ResponseBody
objWrit.Position = 0
objWrit.SaveToFile Location & FileName
objWrit.Close
End If
Set objWebCon = Nothing
Set objWrit = Nothing
End Sub
Situation - I have a macro where I need to send keystrokes to two Firefox windows in order. Unfortunately both windows have the same title. To handle this I have activated the window, sent my keystrokes, then used F6 to load the URL of the second window and then send the keystrokes then use F6 to return it to the original page.
The issue is that loading the webpages is unreliable. Page load speeds vary so much that using a wait command is not consistent or reliable to ensure the keystroke makes it to the second window.
Question -
I've read a scattering of posts that mentioned that app activate will work with Process ID's. Since each window would have its own PID that would be an ideal way to handle 2 windows with the same title. I am unable to find information specifically how to determine the PID of each window with a given name.
You can use something like the following. You'll have to tinker about with the different info available in the Win32_Process class to figure out which window is which. It's also important to keep in mind that one window could mean many processes.
Public Sub getPID()
Dim objServices As Object, objProcessSet As Object, Process As Object
Set objServices = GetObject("winmgmts:\\.\root\CIMV2")
Set objProcessSet = objServices.ExecQuery("SELECT ProcessID, name FROM Win32_Process WHERE name = ""firefox.exe""", , 48)
'you may find more than one processid depending on your search/program
For Each Process In objProcessSet
Debug.Print Process.ProcessID, Process.Name
Next
Set objProcessSet = Nothing
End Sub
Since you'll probably want to explore the options with WMI a bit, you may want to add a Tools>>References to the Microsoft WMI library so you don't have to deal with Dim bla as Object. Then you can add breakpoints and see what's going on in the Locals pane.
After adding the reference:
Public Sub getDetailsByAppName()
Dim objProcessSet As WbemScripting.SWbemObjectSet
Dim objProcess As WbemScripting.SWbemObject
Dim objServices As WbemScripting.SWbemServices
Dim objLocator As WbemScripting.SWbemLocator
'set up wmi for local computer querying
Set objLocator = New WbemScripting.SWbemLocator
Set objServices = objLocator.ConnectServer(".") 'local
'Get all the gory details for a name of a running application
Set objProcessSet = objServices.ExecQuery("SELECT * FROM Win32_Process WHERE name = ""firefox.exe""", , 48)
RecordCount = 1
'Loop through each process returned
For Each objProcess In objProcessSet
'Loop through each property/field
For Each Field In objProcess.Properties_
Debug.Print RecordCount, Field.Name, Field.Value
Next
RecordCount = RecordCount + 1
Next
Set objProcessSet = Nothing
Set objServices = Nothing
Set objLocator = Nothing
End Sub
That will print out every property of every process found for the name 'firefox.exe'.
I have a vbscript that opens a workbook and runs a procedure in the module1 of the workbook, then closes the workbook. Works great. But here's the thing. The path to the workbook is hard coded, like this:
Set xlBook = xlApp.Workbooks.Open("E:\FolderName\WorkbookName.xlsm", 0, True)
I don't mind requiring the user to have the script and the workbook in the same folder, and requiring that they not change the name of the workbook file, but I'd like to just substitute the hard coded path with something dynamic, like:
Set xlBook = xlApp.Workbooks.Open(VBSPath & "\WorkbookName.xlsm", 0, True)
So the path is whatever is the path of the script.
Is that possible? Any other ideas?
tod
VBScript provides various information about the current script and host process via properties of the WScript object, among them:
ScriptFullName: The full path to the current script.
ScriptName: The filename of the current script.
You can derive the script folder from the ScriptFullName property in a number of ways, e.g.
By using the GetParentFolder method:
Set fso = CreateObject("Scripting.FileSystemObject")
dir = fso.GetParentFolderName(WScript.ScriptFullName)
By using the Len and Left functions:
dir = Left(WScript.ScriptFullName, Len(WScript.ScriptFullName)-Len(WScript.ScriptName))
By using the InStrRev and Left functions:
dir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\"))
By using the Split and Join functions:
a = Split(WScript.ScriptFullName, "\")
a(UBound(a)) = ""
dir = Join(a, "\")
By using the Replace function:
dir = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
Note that this approach might prove problematic if (for whatever reason) the script name appears somewhere else in the full name of the script as well (e.g. C:\script.vbs\script.vbs).
You can try like that :
VBSPath = Left(WScript.ScriptFullName,(Len(WScript.ScriptFullName) - (Len(WScript.ScriptName) + 1)))
msgbox VBSPath
I figured out one solution, very similar to what has been posted here.
I created a WScript.Shell object:
Set WshShell = CreateObject("WScript.Shell")
Then I used the CurrentDirectory as the path of the workbook:
Set xlBook = xlApp.Workbooks.Open(WshShell.CurrentDirectory & "\WorkbookName.xlsm", 0, True)
Works!
I want to switch between two audio devices connected to my computer (Windows 7 32 bit). I had a look at question, and found nircmd.
Now, I'm able to create two VBS files to switch between the two devices. I was wondering if I could find out what the current active/default sound device is, then I could put everything in one file itself.
My current code is -
Set WshShell = CreateObject("WScript.Shell")
cmds=WshShell.RUN("L:\MyApps\NirCmd\nircmd.exe setdefaultsounddevice ""Speakers""", 0, True)
Set WshShell = Nothing
The other file has "Headphones" instead of "Speakers".
This is how I solved it currently. This sucks big time, I know. It doesn't find the current active device, instead stores the information in a text file (which has to already exist! With the current device name in it!). Yes, it's horrible. But considering my knowledge of VBScript and current knowledge of the Windows Registry, both of which are very near zero, this is the best I could come up with!
I'm posting this here, because of a lack of a simple answer anywhere else. If anybody has any better solutions, without using any other programs, I'll be very grateful to know.
Also, if anybody wants to use this code, please change the file paths and names to suit yours.
Dim objFso, objFileHandle, strDisplayString
Set objFso = WScript.CreateObject("Scripting.FileSystemObject")
Set readObjFileHandle = objFso.OpenTextFile("L:\MyApps\NirCmd\CurrentDevice.txt", 1)
strDisplayString = readObjFileHandle.ReadLine()
readObjFileHandle.Close
Set writeObjFileHandle = objFso.OpenTextFile("L:\MyApps\NirCmd\CurrentDevice.txt", 2, "True")
If StrComp(strDisplayString, "Headphones", vbTextCompare) = 0 Then
'MsgBox "Headphones - switching to Speakers"
Set WshShell = CreateObject("WScript.Shell")
cmds=WshShell.RUN("L:\MyApps\NirCmd\nircmd.exe setdefaultsounddevice ""Speakers""", 2, True)
Set WshShell = Nothing
writeObjFileHandle.Write("Speakers")
Else
'MsgBox "Speakers - switching to Headphones"
Set WshShell = CreateObject("WScript.Shell")
cmds=WshShell.RUN("L:\MyApps\NirCmd\nircmd.exe setdefaultsounddevice ""Headphones""", 2, True)
Set WshShell = Nothing
writeObjFileHandle.Write("Headphones")
End If
writeObjFileHandle.Close