Switching current active sound device using VBScript? - audio

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

Related

VBS Script not terminating the Excel Application in Task Manager

I have been struggling with what seems to be a common problem regarding opening, running Excel workbook macros, and closing the application from a visual basic script file (.vbs). I cannot terminate the Excel.exe.
I have found a number of recommendations about closing out the objects in the correct order, quitting before setting to nothing, being explicit about each object belonging to the parent object, but I still cannot seem to close of out EXCEL.EXE without manual intervention.
Some mention running a cmd script to kill Excel. I kick off a script like this manually when I have verified it is safe to do so but it is often not. I have dozens of individual batches kicked off each day, and some may be running halfway through during the kick off and completion of another. I would like the .vbs to close its created Excel instance so as to not overrun the memory.
Here is the skeleton of my script:
Set Params = Wscript.Arguments ' some arguments used in the run
Set eApp = CreateObject("Excel.Application")
eApp.Application.DisplayAlerts = False
' CreateObject("WScript.Shell").Run happens here for a log start
Set objWorkbook = eApp.Workbooks.Open("...")
eApp.Application.Visible = True
eApp.Windows(1).Visible = True
eApp.Worksheets(1).Activate
eApp.Application.Run "'...'!...", Cstr(Params(0)), Cstr(Params(1))
objWorkbook.Close False
eApp.Application.DisplayAlerts = True
Set objWorkbook = Nothing
' CreateObject("WScript.Shell").Run happens here for a log complete
eApp.Application.Quit
Set eApp = Nothing
Set Params = Nothing
Wscript.Quit
Is there anything that those more experienced can spot with the above code?

Is there a resolution in VBA for the error Run-time error '429' when trying to connect to a website?

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

Using Print Dialog with Excel Object, Will Only Print to Default Printer Despite Dialog Selection

I have made a quick app for a dept at work that takes users input text fields and writes them to an excel object. The challenge of the project was that it needed to create the worksheet, write to it, print it, clear out certain confidential information, then save it, (has to print before being saved). Everything works great except that when I use the print dialog to select which printer to send it to, it will only print to the user's default printer or last printer used. I don't want to change their default printers as that will confuse them and cause chaos with some other software we have that is really particular to it's printing locations. I've searched tirelessly online and only found solutions for if I am printing a word document and not a worksheet object.
I believe this is all the relevant code:
Imports Excel = Microsoft.Office.Interop.Excel
Dim objExcel As New Excel.Application
Dim objWorkbook As Excel.Workbook
Dim objWorksheet As Excel.Worksheet
Dim PrintDialog1 As New PrintDialog()
Dim result As DialogResult = PrintDialog1.ShowDialog()
If result = DialogResult.OK Then
PrintDialog1.PrinterSettings = PrintDocument1.PrinterSettings
objWorksheet.PrintOutEx()
MessageBox.Show(PrintDialog1.PrinterSettings.PrinterName)
MsgBox("Order Printing Completed")
ElseIf result = DialogResult.Cancel Then
objExcel.DisplayAlerts = False
objWorkbook.Saved = True
objWorkbook.Close(False)
objExcel.Quit()
System.Runtime.InteropServices.Marshal.ReleaseComObject(objWorksheet)
System.Runtime.InteropServices.Marshal.ReleaseComObject(objWorkbook)
System.Runtime.InteropServices.Marshal.ReleaseComObject(objExcel)
ProgressBar1.Value = 200
ProgressBar1.Visible = False
Exit Sub
End If
Also first question on Exchange, so I don't have a lot of privileges, (aka won't be able to respond to comments right away until allowed), also new to coding in general, and this websites' stricter than MLA question and answer protocol, so be kind.
Open the Printers & Scanners settings in Windows.
At the bottom of your list of printers & scanners make sure that "Allow Windows to manage my default printer" is selected/checked/ticked.
Should fix your problem.

Determine Process ID with VBA

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'.

Replace hard-code path with dynamic path of vbscript

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!

Resources