For each loop syntax error - for-loop

There is a problem with this Windows Installer package. A program run as part of the setup did not finish as expected. Contact your support personnel or package vendor
Hey I wrote this script delete shares of a computer but when I run my script it repeats the same wscript.echo statating the share being deleted. Why does my code never end when run How do I fix that.
My fumction:
'The function that is called to run the command Line that deletes a specific share from a pc
Function DeleteThisShare(Share)
Dim objShell
'Logging The deleted Approved Shares
objDeletedFile.WriteLine (Now & " - Removed share " & Trim(Share))
DeleteThisShare = "net share " & chr(34) & Share & chr(34) &" /DELETE"
Wscript.echo DeleteThisShare
Set objShell = CreateObject("Wscript.Shell")
objShell.Run DeleteThisShare
End Function
My loops:
'Compares The UnApproved Shares to the Current Shares
For Each objItem In colItems
Dim StrNonUnapprovedShares, Item
StrCurrentShares = objItem.name
if instr(AdminShares,lcase(objitem.name)) > 0 or mid(objitem.name,2,1) = "$" or left(lcase(objitem.name),10) = "pkgsvrhost" then
'Skipping known admin share
Else
For each Item in arrUnApprovedLines
If Lcase(Item) = Lcase(strCurrentShares) Then
StrNonUnapprovedShares = (StrNonUnapprovedShares & strCurrentShares & vbCrLf)
End If
Next
End If
Next
Dim notUnapprovedShares, notUnapprovedLines
notUnapprovedLines = StrNonUnapprovedShares
notUnapprovedLines = Split(notUnapprovedLines, vbCrLf)
Dim y, Line2
For y = 0 to uBound(notUnapprovedLines)
Line2 = Trim(notUnapprovedLines(y))
If len(Line2) > 0 Then
DeleteThisShare(Line2)
End If
Next

I think the problem is caused by using the function name as a variable. That's okay with VB that you're compiling, but I don't think VBScript recognizes it in the same way. Use a separate variable name in place of DeleteThisShare, e.g. strDeleteThisShare.

If I had to guess it's because you're creating a recursive loop by having your script echo the DeleteThisShare function. The function gets to that line and is called again before it's able to carry on.
Try to only assign values to the result of the function and use local variables to store any other debugging / temporary values.

Related

Waiting while files are zipped in VBScript [duplicate]

I am using VBscript to scan folders, create zip files and add files to them (compress), but as I run my script on folders with a lot of files, I get the following error: "Compressed (zip) Cannot create output file"
my zip handling code is as follows:
Dim objFSO
Set objFSO= CreateObject("Scripting.FileSystemObject"
Function PreformZip(objFile,target,zip_name, number_of_file)
Set shell = CreateObject("WScript.Shell")
zip_target = target + "\" + zip_name +".zip"
If Not objFSO.FileExists(zip_target) Then
MakePathIfNotExist(target)
NewZip(zip_target)
Else
If number_of_file=0 Then
objFSO.DeleteFile(zip_target)
NewZip(zip_target)
End if
End If
Set zipApp = CreateObject("Shell.Application")
aSourceName = Split(objFile, "\")
sSourceName = (aSourceName(Ubound(aSourceName)))
zip_file_count = zipApp.NameSpace(zip_target).items.Count
zipApp.NameSpace(zip_target).Copyhere objFile, 16
On Error Resume Next
sLoop = 0
Do Until zip_file_count < zipApp.NameSpace(zip_target).Items.Count
Wscript.Sleep(100)
sLoop = sLoop + 1
Loop
On Error GoTo 0
End Function
Sub NewZip(zip)
Set new_zip = objFSO.CreateTextFile(zip)
new_zip.Write Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0)
new_zip.Close
Set new_zip = Nothing
WScript.Sleep(5000)
End Sub
Function MakePathIfNotExist(DirPath)
Dim FSO, aDirectories, sCreateDirectory, iDirectory
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FolderExists(DirPath) Then
Exit Function
End If
aDirectories = Split(DirPath, "\")
sCreateDirectory = aDirectories(0)
For iDirectory = 1 To UBound(aDirectories)
sCreateDirectory = sCreateDirectory & "\" & aDirectories(iDirectory)
If Not FSO.FolderExists(sCreateDirectory) Then
FSO.CreateFolder(sCreateDirectory)
End If
Next
End Function
Function Recursion(DirectoryPath)
Dim FSO : Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FolderExists(DirectoryPath) Then Exit Function
Call Recursion(FSO.GetParentFolderName(DirectoryPath))
FSO.CreateFolder(DirectoryPath)
End Function
I first thought I'm not waiting long enough after creating the zip, but I even tried it with 10 seconds wait after each zip and I still get the same error.
How can I solve it?
If there is no solution, is there an alternative way to make a zip? The script is not only for my own use so I don't want ro relay on a software which needs to be installed?
Although Folder.CopyHere method does not return a value and no notification is given to the calling program to indicate that the copy has completed, you could wait with next code snippet and I hope you can see proper (re)placement in your script:
On Error GoTo 0
zipApp.NameSpace(zip_target).Copyhere objFile _
, 4 +8 +16 +256 +512 +1024
Wscript.Sleep( 100)
On Error GoTo 0
Notice: no waiting Do..Loop, this Wscript.Sleep( 100) is sufficient to zip small files or start progress dialog box in case of huge files - and your script will wait for it...
Notice: no 'On Error Resume Next. Avoid invoking On Error Resume Next if you do not handle errors...
Flags used as follows.
Const FOF_SILENT = &h0004 'ineffective?
Const FOF_RENAMEONCOLLISION = &h0008 'ineffective?
Const FOF_NOCONFIRMATION = &h0010 '
Const FOF_SIMPLEPROGRESS = &h0100 'ineffective?
Const FOF_NOCONFIRMMKDIR = &h0200 '
Const FOF_NOERRORUI = &h0400 '
Unfortunately, in some cases, such as compressed (.zip) files, some option flags may be ignored by design (sic!) by MSDN!
If FOF_SILENT flag ineffective, then user could Cancel zipping process...
If FOF_RENAMEONCOLLISION flag ineffective, then newer file of the same name is not zipped, existing zip file keeps previous version without caution against; only existing folder brings on an extra error message...
Those could be fixed up as well, but it's subject of another question...
Well, after a great amount of research I found out that there is no possible way to fix this problem when using shell to perform zip.
I solved this issue by using za7.exe (7-zip) in the following way:
Dim zipParams
zipParams = "a -tzip"
Dim objShell: Set objShell = CreateObject("WScript.Shell")
command = zip_exe_location + " " + zipParams + " " + zip_target + " " + SourceFile
objShell.Run Command, 0 ,true
the "a" in the zip parameters means "add to file" and -tzip sets the type of the file as zip.

Run script in background

I want to run following script as scheduled task on Windows 7 in background. Now, script displays cmd window and, can I run script without visible cmd window?
Option Explicit
Dim WshShell, oExec
Dim RegexParse
Dim hasError : hasError = 0
Set WshShell = WScript.CreateObject("WScript.Shell")
Set RegexParse = New RegExp
Set oExec = WshShell.Exec("%comspec% /c echo list volume | diskpart.exe")
RegexParse.Pattern = "\s\s(Volume\s\d)\s+([A-Z])\s+(.*)\s\s(NTFS|FAT)\s+(Mirror|RAID-5)\s+(\d+)\s+(..)\s\s([A-Za-z]*\s?[A-Za-z]*)(\s\s)*.*"
While Not oExec.StdOut.AtEndOfStream
Dim regexMatches
Dim Volume, Drive, Description, Redundancy, RaidStatus
Dim CurrentLine : CurrentLine = oExec.StdOut.ReadLine
Set regexMatches = RegexParse.Execute(CurrentLine)
If (regexMatches.Count > 0) Then
Dim match
Set match = regexMatches(0)
If match.SubMatches.Count >= 8 Then
Volume = match.SubMatches(0)
Drive = match.SubMatches(1)
Description = Trim(match.SubMatches(2))
Redundancy = match.SubMatches(4)
RaidStatus = Trim(match.SubMatches(7))
End If
If RaidStatus <> "Healthy" Then
hasError = 1
'WScript.StdOut.Write "WARNING "
MsgBox "Status of " & Redundancy & " " & Drive & ": (" & Description & ") is """ & RaidStatus & """", 16, "RAID error"
End If
End If
Wend
WScript.Quit(hasError)
Thanks a lot
Option 1 - If the task is running under your user credentials (if not, msgbox will not be visible)
There are two possible sources for the cmd window.
a) The script itself. If the task is executing cscript, the console window will be visible, avoid it calling wscript instead
b) The Shell.exec call. The only way to hide this window is to start the calling script hidden. On start of your script test for the presence of certain argument. If not present, make the script call itself with the argument, using Run method of the WshShell object, and indicating to run the script with hidden window. Second instance of the script will start with the special parameter, so it will run, but this time windows will be hidden.
Option 2 - Running the task under system credentials.
In this case, no window will be visible. All will be running in a separate session. BUT msgbox will not be seen. Change MsgBox call with a call to msg.exe and send a message to current console user.

vbScript to execute all files in a dir

I'm trying to write a vbScript that will execute all files in a given directory (will be mostly batch files).
I've tried to modify a script that deletes all files but I'm not able to get it to work.
Here is what I have:
Option Explicit
'===========================================================================
' Scheduled Task - Visual Basic ActiveX Script
'===========================================================================
Call ExecuteDirectory("c:\users\public\documents\schedule\daily")
Function ExecuteDirectory(strPath2Folder)
Dim fso, f, fc, f1, strFiles, intFiles
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
strFiles = ""
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FolderExists(strPath2Folder)) Then
Set f = fso.GetFolder(strPath2Folder)
Set fc = f.Files
'-- Execute each file in Folder
For Each f1 in fc
strFiles = strFiles & f1.Name & vbCrLf
msgbox strPath2Folder & "\" & strFiles
WshShell.Run Chr(34) & strFiles & Chr(34), 1, true
Next
Set f1 = Nothing
Set fc = Nothing
Set f = Nothing
End If
Set fso = Nothing
End Function
The msgbox line displays the full path and file name that I want to execute, but the run line generates file not found error.
The variable strFiles continually builds up a list of files with line breaks in between. For example, if your folder contains the files "test1.bat" and "test2.bat", you will end up with this:
Iteration 1:
strFiles =
test1.bat
Iteration 1:
strFiles =
test1.bat
test2.bat
I don't think this is what you want to do. If you want to just run each script in order, you should just pass the single script name.
Try changing the inner loop to this:
For Each f1 in fc
Dim fileToRun
fileToRun = strPath2Folder & "\" & f1.Name
WshShell.Run Chr(34) & fileToRun & Chr(34), 1, true
Next
This is a very sloppy approach. If you are needing to execute an entire directory of batch files at one time, then you are not using them correctly. You should only need one batch file or one script an any time. I would begin looking at your whole system for a better approach to whatever it is that you are trying to accomplish.

How to Retrieve a File's "Product Version" in VBScript

I have a VBScript that checks for the existence of a file in a directory on a remote machine. I am looking to retrieve the "Product Version" for said file (NOT "File Version"), but I can't seem to figure out how to do that in VBScript.
I'm currently using Scripting.FileSystemObject to check for the existence of the file.
Thanks.
I use a function that is slightly modified from the previous example. The function takes the path and file name and returns the "Product Version"
Function GetProductVersion (sFilePath, sProgram)
Dim FSO,objShell, objFolder, objFolderItem, i
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(sFilePath & "\" & sProgram) Then
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(sFilePath)
Set objFolderItem = objFolder.ParseName(sProgram)
Dim arrHeaders(300)
For i = 0 To 300
arrHeaders(i) = objFolder.GetDetailsOf(objFolder.Items, i)
'WScript.Echo i &"- " & arrHeaders(i) & ": " & objFolder.GetDetailsOf(objFolderItem, i)
If lcase(arrHeaders(i))= "product version" Then
GetProductVersion= objFolder.GetDetailsOf(objFolderItem, i)
Exit For
End If
Next
End If
End Function
I've found that the position of the attributes has occasionally changes (not sure why) in XP and Vista so I look for the "product version" attribute and exit the loop once it's found. The commented out line will show all the attributes and a value if available
You can use the Shell.Namespace to get the extended properties on a file, one of which is the Product Version. The GetDetailsOf function should work. You can test with the following code to get an idea:
Dim fillAttributes(300)
Set shell = CreateObject("Shell.Application")
Set folder = shell.Namespace("C:\Windows")
Set file = folder.ParseName("notepad.exe")
For i = 0 to 299
Wscript.Echo i & vbtab & fillAttributes(i) _
& ": " & folder.GetDetailsOf(file, i)
Next
One thing to be aware of:
The extended properties of a file differs between versions of Windows. Hence, the product version index numbers changes based on the version of Windows you are using. You can use the code above to determine what they are. From my testing, I believe they are as follows:
Window XP - 39
Windows Vista - 252
Windows 7 - 268
Windows 2008 R2 SP1 - 271
Windows 2012 R2 - 285
You may also find the following post helpful.
The product version can be retrieved directly with the ExtendedProperty method.
function GetProductVersion(Path)
dim shell, file
set shell = CreateObject("Shell.Application")
const ssfDesktop = 0
set file = shell.Namespace(ssfDesktop).ParseName(Path)
if not (file is nothing) then
GetProductVersion = _
file.ExtendedProperty("System.Software.ProductVersion")
end if
end function
By contrast with a couple of older answers,
This does not require looping over an unknown or arbitrary number of columns with GetDetailsOf.
This uses the canonical name of the property, not the display name. One can also use the FMTID and PID: "{0CEF7D53-FA64-11D1-A203-0000F81FEDEE} 8".
This avoids the need to split the path into directory and name, by starting at the root (desktop) namespace.
' must explicitly declare all variables
Option Explicit
' declare global variables
Dim aFileFullPath, aDetail
' set global variables
aFileFullPath = "C:\Windows\Notepad.exe"
aDetail = "Product Version"
' display a message with file location and file detail
WScript.Echo ("File location: " & vbTab & aFileFullPath & vbNewLine & _
aDetail & ": " & vbTab & fGetFileDetail(aFileFullPath, aDetail))
' make global variable happy. set them free
Set aFileFullPath = Nothing
Set aDetail = Nothing
' get file detail function. created by Stefan Arhip on 20111026 1000
Function fGetFileDetail(aFileFullPath, aDetail)
' declare local variables
Dim pvShell, pvFileSystemObject, pvFolderName, pvFileName, pvFolder, pvFile, i
' set object to work with files
Set pvFileSystemObject = CreateObject("Scripting.FileSystemObject")
' check if aFileFullPath provided exists
If pvFileSystemObject.FileExists(aFileFullPath) Then
' extract only folder & file from aFileFullPath
pvFolderName = pvFileSystemObject.GetFile(aFileFullPath).ParentFolder
pvFileName = pvFileSystemObject.GetFile(aFileFullPath).Name
' set object to work with file details
Set pvShell = CreateObject("Shell.Application")
Set pvFolder = pvShell.Namespace(pvFolderName)
Set pvFile = pvFolder.ParseName(pvFileName)
' in case detail is not detected...
fGetFileDetail = "Detail not detected"
' parse 400 details for given file
For i = 0 To 399
' if desired detail name is found, set function result to detail value
If uCase(pvFolder.GetDetailsOf(pvFolder.Items, i)) = uCase(aDetail) Then
fGetFileDetail = pvFolder.GetDetailsOf(pvFile, i)
End If
Next
' if aFileFullPath provided do not exists
Else
fGetFileDetail = "File not found"
End If
' make local variable happy. set them free
Set pvShell = Nothing
Set pvFileSystemObject = Nothing
Set pvFolderName = Nothing
Set pvFileName = Nothing
Set pvFolder = Nothing
Set pvFile = Nothing
Set i = Nothing
End Function
Wscript.Echo CreateObject("Scripting.FileSystemObject").GetFileVersion("C:\Windows\notepad.exe")

Use clipboard from VBScript

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

Resources