I use the following approach sucessfully to copy the selected text from other applications.
The following works fine for Notepad:
Dim ThreadID1&
Dim ThreadID2&
'
' First need to get the thread responsible for this window,
' and the thread for the foreground window.
Dim lFore&
lFore = GetForegroundWindow()
Debug.Print "foreground: " & modWindow.WindowTitleFromHwnd(lFore)
ThreadID1 = GetWindowThreadProcessId(lFore, ByVal 0&)
'By sharing input state, threads share their concept of
' the active window
Call AttachThreadInput(ThreadID1, ThreadID2, True)
Dim guiInfo As GUITHREADINFO
guiInfo.cbSize = Len(guiInfo)
Dim lRet&
lRet = GetGUIThreadInfo(ThreadID1, guiInfo)
Debug.Assert guiInfo.hwndCaret <> 0
If guiInfo.hwndCaret = 0 Then
Debug.Print "lastdll error: " & Err.LastDLLError
Debug.Assert False
End If
Dim s$
s = GetCaretWindowText(guiInfo.hwndCaret, true)
Debug.Print "Text: " & s
Call AttachThreadInput(ThreadID1, ThreadID2, False)
The problem is that - if I use Chrome browser instead of Notepad - the following occurs:
guiInfo.hwndCaret = 0
However, GetGUIThreadInfo returns True, so there is no obvious error in my approach, I think.
What might be my mistake here?
I am attempting to close a shell Chrome window via a VBA function. My function runs a URL query that returns a .csv file. The thing is I would like to close the window so that it is not always showing (This process runs every 3 minutes). I haven't been able to find a solution that I can get to work as of yet. I tried adding SendKeys "%{F4}" after as one site suggested. This merely minimizes the window, not close it. I also attempted to try adding DoCmd.Close Shell, "Untitled" after, yet this also did not work. I have spent several hours attempting to do, what I imagine is a simple task, and felt another set of eyes could point me in the right direction. Below is my code that opens Chrome. Any assistance is greatly appreciated.
Public Function RunYahooAPI()
Dim chromePath As String
chromePath = """C:\Program Files\Google\Chrome\Application\chrome.exe"""
Shell (chromePath & " -url http://download.finance.yahoo.com/d/quotes.csv?s=CVX%2CXOM%2CHP%2CSLB%2CPBA%2CATR%2CECL%2CNVZMY%2CMON&f=nsl1op&e=.csv")
End Function
this VBA code will launch (as in your question) chrome, save the Process handle in the variable pHandle, loop all processes with this Handle and then stop the process (after checking user and domain of the process owner) .
Sub LaunchandStopProcess()
'
' As in your Question
'
Dim chromePath As String
Dim pHandle As Variant
chromePath = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"
'
' Note: Shell pass the Process Handle to the PID variable
'
PHandle = Shell(chromePath & " -url http://download.finance.yahoo.com/d/quotes.csv?s=CVX%2CXOM%2CHP%2CSLB%2CPBA%2CATR%2CECL%2CNVZMY%2CMON&f=nsl1op&e=.csv")
Dim objWMIcimv2 As Object
Dim objProcess As Object
Dim objList As Object
Dim ProcToTerminate As String
Dim intError As Integer
Set objWMIcimv2 = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
Set objList = objWMIcimv2.ExecQuery("select * from win32_process where Handle='" & CStr(pHandle) & "'")
'
' ObjList contains the list of all process matching the Handle (normally your chrome App, if running)
'
If objList.Count = 0 Then
' No matching Process
' Set all objects to nothing
Set objWMIcimv2 = Nothing
Set objList = Nothing
Set objProcess = Nothing
Exit Sub
Else
'
' Parse all matching Processes
'
For Each objProcess In objList
' additionally check with actual user
colProperties = objProcess.getowner(strNameofUser, strUserdomain)
If strUserdomain + "\" + strNameofUser = Environ$("userdomain") + "\" + Environ$("username") Then
intError = objProcess.Terminate
If intError <> 0 Then
'
' Trap Error or do nothing if code run unattended
'
Else
' Confirm that process is killed or nothing if code run unattended
End If
End If
Next
Set objWMIcimv2 = Nothing
Set objList = Nothing
Set objProcess = Nothing
End If
End Sub
I'm having some issues with my vbs script. It will add only the F drive and not add the G driver after it. What am I doing wrong?
'## This is for network drives
Set objNetwork = CreateObject("WScript.Network")
objNetwork.RemoveNetworkDrive "F:", True, True
'## for adding
Set objNetwork = CreateObject("WScript.Network")
objNetwork.MapNetworkDrive "F:" , "\\myserver\share1"
objNetwork.MapNetworkDrive "G:" , "\\myserver\share2"
MapDrive.vbs
VBScript to Map a Drive letter to a network file share (non-persistent).
This script is designed for reliability above speed, so it will reconnect at every login.
It accounts for 'remembered' connections including those to a file share that no longer exists or which is off-line.
This is a good approach for machines that are not always connected to the domain e.g. Laptops.
Windows XP will not map a 'remembered' connection to a different server unless you first unmap & unremember the existing connection, this applies even if the old connection path is currently disconnected.
For each drive letter there are several possible states, that may have to be dealt with by the script:
- Remembered (persistent connection) / Not Remembered
- Already Connected / Connected to the wrong network share / Not Connected.
This script will remove any existing Drive Map, before connecting to the correct file share.
' Map a network drive
' Usage
' cscript MapDrive.vbs drive fileshare //NoLogo
' cscript MapDrive.vbs H: \\MyServer\MyShare //NoLogo
'
' This script will remove any existing drive map to the same drive letter
' including persistent or remembered connections (Q303209)
Option Explicit
Dim objNetwork, objDrives, objReg, i
Dim strLocalDrive, strRemoteShare, strShareConnected, strMessage
Dim bolFoundExisting, bolFoundRemembered
Const HKCU = &H80000001
' Check both parameters have been passed
If WScript.Arguments.Count < 2 Then
wscript.echo "Usage: cscript MapDrive.vbs drive fileshare //NoLogo"
WScript.Quit(1)
End If
strLocalDrive = UCase(Left(WScript.Arguments.Item(0), 2))
strRemoteShare = WScript.Arguments.Item(1)
bolFoundExisting = False
' Check parameters passed make sense
If Right(strLocalDrive, 1) <> ":" OR Left(strRemoteShare, 2) <> "\\" Then
wscript.echo "Usage: cscript MapDrive.vbs drive fileshare //NoLogo"
WScript.Quit(1)
End If
wscript.echo " - Mapping: " + strLocalDrive + " to " + strRemoteShare
Set objNetwork = WScript.CreateObject("WScript.Network")
' Loop through the network drive connections and disconnect any that match strLocalDrive
Set objDrives = objNetwork.EnumNetworkDrives
If objDrives.Count > 0 Then
For i = 0 To objDrives.Count-1 Step 2
If objDrives.Item(i) = strLocalDrive Then
strShareConnected = objDrives.Item(i+1)
objNetwork.RemoveNetworkDrive strLocalDrive, True, True
i=objDrives.Count-1
bolFoundExisting = True
End If
Next
End If
' If there's a remembered location (persistent mapping) delete the associated HKCU registry key
If bolFoundExisting <> True Then
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
objReg.GetStringValue HKCU, "Network\" & Left(strLocalDrive, 1), "RemotePath", strShareConnected
If strShareConnected <> "" Then
objReg.DeleteKey HKCU, "Network\" & Left(strLocalDrive, 1)
Set objReg = Nothing
bolFoundRemembered = True
End If
End If
'Now actually do the drive map (not persistent)
Err.Clear
On Error Resume Next
objNetwork.MapNetworkDrive strLocalDrive, strRemoteShare, False
'Error traps
If Err <> 0 Then
Select Case Err.Number
Case -2147023694
'Persistent connection so try a second time
On Error Goto 0
objNetwork.RemoveNetworkDrive strLocalDrive, True, True
objNetwork.MapNetworkDrive strLocalDrive, strRemoteShare, False
WScript.Echo "Second attempt to map drive " & strLocalDrive & " to " & strRemoteShare
Case Else
On Error GoTo 0
WScript.Echo " - ERROR: Failed to map drive " & strLocalDrive & " to " & strRemoteShare
End Select
Err.Clear
End If
Set objNetwork = Nothing
From http://ss64.com/vb/syntax-mapdrive.html
I've done this before like this:
dim objNet, strLocal, strPath, fso
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set objNet = WScript.CreateObject("WScript.Network")
'Name the drives and their paths
strLocal = Array("H:","M:")
strPath = Array("\\Full\Path\Number1", _
\\Full\Path\Number2")
'Loop to check if they are mapped, map it if they are not
For i = LBound(strLocal) To UBound(strLocal)
If fso.FolderExists(strLocal(i)) = True Then
wscript.echo(strLocal(i) & " Mapped")
Else
objNet.MapNetworkDrive strLocal(i), strPath(i), False
wscript.echo(strLocal(i) & " Re-mapped")
End If
Next
'Wrap up the script
WScript.Echo("")
WScript.Echo("Mapping Completed")
WScript.Sleep(2000)
'Keep the command prompt open long enough to see that it is completed
Set fso=Nothing
Set objNet=Nothing
Essentially, it checks to see if the drive is mapped already, and if not, then it will map it. I added this to my startup folder because I keep getting my corp network drives to lose connection when I reboot.
I've recently changed from a PC to a Mac. I run a lot of a macros and 99% of them are running fine, but I have one that doesn't work on a Mac.
It runs a set of other macros across all workbooks in a file. To do this it uses strings like this:
Function BrowseFolder(Title As String, _
Optional InitialFolder As String = vbNullString, _
Optional InitialView As Office.MsoFileDialogView = _
msoFileDialogViewList) As String
When I try to run this on the Mac it comes back with an error:
"compile error: variable not defined"
I wonder if anyone could help me with porting this macro over to run on Mac. It was built on Excel 2007 Windows and I'm trying to run it on Excel 2011 Mac.
Option Explicit
Function GetFolder(Optional strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
If Not IsEmpty(strPath) Then
.InitialFileName = strPath
End If
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function
Private Sub test()
Dim v As Variant
'V = GetFolder()
v = BrowseFolder("Select folder")
End Sub
Function BrowseFolder(Title As String, _
Optional InitialFolder As String = vbNullString, _
Optional InitialView As Office.MsoFileDialogView = _
msoFileDialogViewList) As String
Dim v As Variant
Dim InitFolder As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = Title
.InitialView = InitialView
If Len(InitialFolder) > 0 Then
If Dir(InitialFolder, vbDirectory) <> vbNullString Then
InitFolder = InitialFolder
If Right(InitFolder, 1) <> "\" Then
InitFolder = InitFolder & "\"
End If
.InitialFileName = InitFolder
End If
End If
.Show
On Error Resume Next
Err.Clear
v = .SelectedItems(1)
If Err.Number <> 0 Then
v = vbNullString
End If
End With
BrowseFolder = CStr(v)
End Function
msoFileDialogViewList refers to a specific view of the Windows standard file dialog. The Mac standard file dialog doesn't have equivalent modes; my guess is that the InitialView parameter either doesn't exist or is ignored on the Mac platform.
I'd advise either removing the parameter entirely or using the equivalent integer value (1) instead of the symbolic name.
I am looking for a method to place some text onto the clipboard with VBScript. The VBScript in question will be deployed as part of our login script. I would like to avoid using anything that isn't available on a clean Windows XP system.
Edit:
In answer to the questions about what this is for.
We wanted to encourage users inside our organization to use the file server to transfer documents instead of constantly sending attachments by email. One of the biggest barriers to this is that it isn't always obvious to people what the correct network path is to a file/folder. We developed a quick script, and attached it to the Windows context menu so that a user can right click on any file/folder, and get a URL that they can email to someone within our organization.
I want the URL displayed in the dialog box to also be placed onto the clipboard.
GetNetworkPath
Another solution I have found that isn't perfect in my opinion, but doesn't have the annoying security warnings is to use clip.exe from a w2k3 server.
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run "cmd.exe /c echo hello world | clip", 0, TRUE
Example with a multiline string as per question below :
Link1
Dim string
String = "text here" &chr(13)& "more text here"
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run "cmd.exe /c echo " & String & " | clip", 0, TRUE
Using Microsoft's clip.exe is the closest to having a clean Windows XP system solution. However you don't have to call CMD.EXE to host it in order to use it. You can call it directly and write to its input stream in your script code. Once you close the input stream clip.exe will write the contents straight to the clipboard.
Set WshShell = CreateObject("WScript.Shell")
Set oExec = WshShell.Exec("clip")
Set oIn = oExec.stdIn
oIn.WriteLine "Something One"
oIn.WriteLine "Something Two"
oIn.WriteLine "Something Three"
oIn.Close
If you need to wait for clip to be finished before your script can continue processing then add
' loop until we're finished working.
Do While oExec.Status = 0
WScript.Sleep 100
Loop
And don't forget to release your objects
Set oIn = Nothing
Set oExec = Nothing
The closest solution I have found so far is a method to use IE to get and set stuff on the clipboard. The problem with this solution is the user gets security warnings. I am tempted to move 'about:blank' to the local computer security zone so I don't get the warnings, but I am not sure what the security implications of that would be.
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Navigate("about:blank")
objIE.document.parentwindow.clipboardData.SetData "text", "Hello This Is A Test"
objIE.Quit
http://www.microsoft.com/technet/scriptcenter/resources/qanda/dec04/hey1215.mspx
No security warnings, full let and get access:
'create a clipboard thing
Dim ClipBoard
Set Clipboard = New cClipBoard
ClipBoard.Clear
ClipBoard.Data = "Test"
Class cClipBoard
Private objHTML
Private Sub Class_Initialize
Set objHTML = CreateObject("htmlfile")
End Sub
Public Sub Clear()
objHTML.ParentWindow.ClipboardData.ClearData()
End Sub
Public Property Let Data(Value)
objHTML.ParentWindow.ClipboardData.SetData "Text" , Value
End Property
Public Property Get Data()
Data = objHTML.ParentWindow.ClipboardData.GetData("Text")
End Property
Private Sub Class_Terminate
Set objHTML = Nothing
End Sub
End Class
Example Usage.
' Create scripting object
Dim WShell, lRunUninstall
Set WShell = CreateObject("WScript.Shell")
WShell.sendkeys "^c"
WScript.Sleep 250
bWindowFound = WShell.AppActivate("Microsoft Excel")
WShell.sendkeys ClipBoard.Data
To avoid the security warnings associated with Internet Explorer and clipboard access, I would recommend you use the Word application object and its methods to put your data onto the clipboard. Of course you can only use this on a machine that has MS Word installed, but these days that's most of them. (*In spite of the fact that you asked for stuff on a 'clean' system :) *)
' Set what you want to put in the clipboard '
strMessage = "Imagine that, it works!"
' Declare an object for the word application '
Set objWord = CreateObject("Word.Application")
' Using the object '
With objWord
.Visible = False ' Don't show word '
.Documents.Add ' Create a document '
.Selection.TypeText strMessage ' Put text into it '
.Selection.WholeStory ' Select everything in the doc '
.Selection.Copy ' Copy contents to clipboard '
.Quit False ' Close Word, don't save '
End With
You can find detail on the MS Word application object and its methods here: http://msdn.microsoft.com/en-us/library/aa221371(office.11).aspx
Microsoft doesn't give a way for VBScript to directly access the clipboard. If you do a search for 'clipboard'on this site you'll see:
Although Visual Basic for Applications supports the Screen, Printer, App, Debug, Err, and Clipboard objects, VBScript supports only the Err object. Therefore, VBScript does not allow you to access such useful objects as the mouse pointer or the clipboard. You can, however, use the Err object to provide runtime error handling for your applications.
So using notepad indirectly is probably about the best you'll be able to do with just VBScript.
Here's another version of using the "clip" command, which avoids adding a carriage return, line feed to the end of the string:
strA= "some character string"
Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Run "cmd /C echo . | set /p x=" & strA & "| c:\clip.exe", 2
s = "String: """ & strA & """ is on the clipboard."
Wscript.Echo s
I've only tested this in XP. clip.exe was downloaded from Link and placed in C:\.
I've found a way to copy multi line information to clipboard by vbscript/cmd.
Sequence:
with VBS generate the final "formatted string" that you need copy to clipboard
generate a (txt) file with the "formatted string"
use type command from cmd to paste information to clip by pipe
Example script:
Function CopyToClipboard( sInputString )
Dim oShell: Set oShell = CreateObject("WScript.Shell")
Dim sTempFolder: sTempFolder = oShell.ExpandEnvironmentStrings("%TEMP%")
Dim sFullFilePath: sFullFilePath = sTempFolder & "\" & "temp_file.txt"
Const iForWriting = 2, bCreateFile = True
Dim oFSO: Set oFSO = CreateObject("Scripting.FileSystemObject")
With oFSO.OpenTextFile(sFullFilePath, iForWriting, bCreateFile)
.Write sInputString
.Close
End With
Const iHideWindow = 0, bWaitOnReturnTrue = True
Dim sCommand: sCommand = "CMD /C TYPE " & sFullFilePath & "|CLIP"
oShell.Run sCommand, iHideWindow, bWaitOnReturnTrue
Set oShell = Nothing
Set oFSO = Nothing
End Function
Sub Main
Call CopyToClipboard( "Text1" & vbNewLine & "Text2" )
End Sub
Call Main
The easiest way is to use built-in mshta.exe functionality:
sText = "Text Content"
CreateObject("WScript.Shell").Run "mshta.exe ""javascript:clipboardData.setData('text','" & Replace(Replace(sText, "\", "\\"), "'", "\'") & "');close();""", 0, True
To put to clipboard a string containing double quote char ", use the below code:
sText = "Text Content and double quote "" char"
CreateObject("WScript.Shell").Run "mshta.exe ""javascript:clipboardData.setData('text','" & Replace(Replace(Replace(sText, "\", "\\"), """", """"""), "'", "\'") & "'.replace('""""',String.fromCharCode(34)));close();""", 0, True
Take a look at this post. It describes a hacky approach to read from the clipboard, but I imagine it could be adapted to also write to the clipboard as well, such as changing the Ctrl+V to Ctrl+A then Ctrl+C.
I devised another way to use IE and yet avoid security warnings...
By the way.. this function is in JavaScript.. but u can easily convert it to VBScript..
function CopyText(sTxt) {
var oIe = WScript.CreateObject('InternetExplorer.Application');
oIe.silent = true;
oIe.Navigate('about:blank');
while(oIe.ReadyState!=4) WScript.Sleep(20);
while(oIe.document.readyState!='complete') WSript.Sleep(20);
oIe.document.body.innerHTML = "<textarea id=txtArea wrap=off></textarea>";
var oTb = oIe.document.getElementById('txtArea');
oTb.value = sTxt;
oTb.select();
oTb = null;
oIe.ExecWB(12,0);
oIe.Quit();
oIe = null;
}
Here is Srikanth's method translated into vbs
function SetClipBoard(sTxt)
Set oIe = WScript.CreateObject("InternetExplorer.Application")
oIe.silent = true
oIe.Navigate("about:blank")
do while oIe.ReadyState <> 4
WScript.Sleep 20
loop
do while oIe.document.readyState <> "complete"
WScript.Sleep 20
loop
oIe.document.body.innerHTML = "<textarea id=txtArea wrap=off></textarea>"
set oTb = oIe.document.getElementById("txtArea")
oTb.value = sTxt
oTb.select
set oTb = nothing
oIe.ExecWB 12,0
oIe.Quit
Set oIe = nothing
End function
function GetClipBoard()
set oIe = WScript.CreateObject("InternetExplorer.Application")
oIe.silent = true
oIe.Navigate("about:blank")
do while oIe.ReadyState <> 4
WScript.Sleep 20
loop
do while oIe.document.readyState <> "complete"
WScript.Sleep 20
loop
oIe.document.body.innerHTML = "<textarea id=txtArea wrap=off></textarea>"
set oTb = oIe.document.getElementById("txtArea")
oTb.focus
oIe.ExecWB 13,0
GetClipBoard = oTb.value
oTb.select
set oTb = nothing
oIe.Quit
Set oIe = nothing
End function
In your Class ClipBoard, neither the Clear sub nor the Let Data sub work. I mean they have no effect on Windows Clipboard. Actually, and ironically so, the only sub that works is the one you have not included in your example, that is Get Data! (I have tested this code quite a few times.)
However, it's not your fault. I have tried to copy data to clipboard with ClipboardData.SetData and it's impossible. At least not by creating an "htmlfile" object. Maybe it works by creating an instance of "InternetExplorer.Application" as I have seen in a few cases, but I have not tried it. I hate creating application instances for such simple tasks!
Alkis
If it's just text can't you simply create a text file and read in the contents when you need it?
Another alternative and clearly a kludge, would be to use the SendKeys() method.
No security warnings and no carriage return at the end of line
' value to put in Clipboard
mavaleur = "YEAH"
' current Dir
path = WScript.ScriptFullName
GetPath = Left(path, InStrRev(path, "\"))
' Put the value in a file
Set objFSO=CreateObject("Scripting.FileSystemObject")
outFile=GetPath & "fichier.valeur"
Set objFile = objFSO.CreateTextFile(outFile,True)
objFile.Write mavaleur
objFile.Close
' Put the file in the Clipboard
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run "cmd.exe /c clip < " & outFile, 0, TRUE
' Erase the file
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFile outFile