VBA Clipboard fast read - performance

I have problem with reading data from clipboard at fast rate. I have one program that sends data 10 times per sec to clipboard, and now in VBA I want to recive that data.
Code im using:
Dim clipboard As MSForms.DataObject
Dim strContents As String
Set clipboard = New MSForms.DataObject
Do While True
clipboard.GetFromClipboard
strContents = clipboard.GetText
clipboard.Clear
Myfunc(strContents)
ThisApplication.StatusBarText = strContents 'debug
If Left(strContents, 1) = 9 Then Exit Sub 'end condition
Set clipboad = Nothing
sleep 100
Loop
End Sub
There is problem: this code is working for about 2 sec and then I get error:
DataObject:GetText 8007000E - Ran out of memory.
The clipboard data is non stop this same. Im clearing objects every loop. Where is problem? Im on 64 bit windows 7, 64 bit VBA application, 8 gigs of ram.

As Patrick pointed out, you should move the Set clipboard = Nothing below the loop. Also, there is a typo, as it is currently written as set clipboad = Nothing.
In addition, insert DoEvents after you clear your clipboard. This will make sure that the operating system has time to clear it before you read it again.
Your final code should look somehow like this:
Dim clipboard As MSForms.DataObject
Dim strContents As String
Set clipboard = New MSForms.DataObject
Do While True
clipboard.GetFromClipboard
strContents = clipboard.GetText
clipboard.Clear
DoEvents
Myfunc(strContents)
ThisApplication.StatusBarText = strContents 'debug
If Left(strContents, 1) = 9 Then Exit Sub 'end condition
sleep 100
Loop
Set clipboard = Nothing

Related

How to randomly play a sound file from a directory using vbscript

I'm trying to have windows run this vbs file at the start of windows so that the computer can greet me with phrases that I've made and saved as wav files.
I already have one vbs file where it plays a sound file but I want it to randomly pick one from a specific directory so that it doesn't get old hearing the same thing over and over again, plus add a surprise factor because I don't know which one it'll use each time I start the computer.
Dim oPlayer
Set oPlayer = CreateObject("WMPlayer.OCX")
' Play audio
oPlayer.URL = "C:\Users\david\OneDrive\Desktop\GLaDOS
wav\Edited\hello_david_youre_back_i_see.wav"
oPlayer.controls.play
While oPlayer.playState <> 1 ' 1 = Stopped
WScript.Sleep 100
Wend
' Release the audio file
oPlayer.close
Thanks for your help in advance.
Option Explicit
Dim oFolderItems
Dim oFolderItem
Dim aFiles
Set oFolderItems = CreateObject("Shell.Application").NameSpace("C:\Users\david\OneDrive\Desktop\GLaDOSwav\Edited").Items
oFolderItems.Filter 64 + 128, "*.wav"
With CreateObject("Scripting.Dictionary")
For Each oFolderItem In oFolderItems
.Item(.Count) = oFolderItem.Path
Next
aFiles = .Items
End With
Randomize
With CreateObject("WMPlayer.OCX")
.URL = aFiles(Int(Rnd * UBound(aFiles) + 1))
.controls.play
Do While .playState <> 1
WScript.Sleep 100
Loop
.close
End With

Opening Word from VBScript hangs, can't figure out why

I'm not really a programmer by trade, so forgive me if I'm not aware of any standard debugging tools.
I have what I thought was a very simple VBScript (just a txt file saved with a .vbs extension):
Const wdDoNotSaveChanges = 0
Const wdRevisionsViewFinal = 0
Const wdFormatPDF = 17
Dim arguments
Set arguments = WScript.Arguments
Function DOC2PDF(sDocFile)
Dim fso ' As FileSystemObject
Dim wdo ' As Word.Application
Dim wdoc ' As Word.Document
Dim wdocs ' As Word.Documents
Set fso = CreateObject("Scripting.FileSystemObject")
sDocFile = fso.GetAbsolutePathName(sDocFile)
sPdfFile = fso.GetParentFolderName(sDocFile) + "\" + fso.GetBaseName(sDocFile) + ".pdf"
Set wdo = CreateObject("Word.Application")
Set wdocs = wdo.Documents
Set wdoc = wdocs.Open(sDocFile)
if fso.FileExists(sPdfFile) Then
fso.DeleteFile sPdfFile, True
End If
Set wview = wdoc.ActiveWindow.View
wview.ShowRevisionsAndComments = False
wview.RevisionsView = wdRevisionsViewFinal
wdoc.SaveAs sPdfFile, wdFormatPDF
wdo.Quit wdDoNotSaveChanges
Set fso = Nothing
Set wdo = Nothing
End Function
however, the following line is causing huge grief:
Set wdoc = wdocs.Open(sDocFile)
Sometimes the Word ActiveX object just freezes at this step. I've verified this by some super-simple debugging by putting a WriteLine after each line and seeing where it stops.
Word just sits there consuming 100% CPU, and the script never gets past that step.
How can I go about debugging to find out what the hell is going on with the Word ActiveX object and why it's just hanging and never returning?
Word might be waiting for a prompt from you. I would make Word visible and see if you can visually see what the problem is:
Set wdo = CreateObject("Word.Application")
'if memory serves, this should make Word visible
wdo.Visible = true
Set wdocs = wdo.Documents

Write to file using CopyHere without using WScript.Sleep

I've written a small VBScript to creates a .zip file and then copies the contents of a specified folder into that .zip file.
I copy the files over one by one for a reason (I know I can do the whole lot at once). However my problem is when I try to copy them one by one without a WScript.Sleep between each loop iteration I get a "File not found or no read permission." error; if I place a WScript.Sleep 200 after each write it works but not 100% of the time.
Pretty much I'd like to get rid of the Sleep function and not rely on that because depending on the file size it may take longer to write therefore 200 milliseconds may not be enough etc.
As you can see with the small piece of code below, I loop through the files, then if they match the extension I place them into the .zip (zipFile)
For Each file In folderToZip.Items
For Each extension In fileExtensions
if (InStr(file, extension)) Then
zipFile.CopyHere(file)
WScript.Sleep 200
Exit For
End If
Next
Next
Any suggestions on how I can stop relying on the Sleep function?
Thanks
This is how we do it in VB6. After calling CopyHere on the zip we wait for async compression to complete like this
Call Sleep(100)
Do
Do While Not pvCanOpenExclusive(sZipFile)
Call Sleep(100)
Loop
Call Sleep(100)
Loop While Not pvCanOpenExclusive(sZipFile)
where the helper function looks like this
Private Function pvCanOpenExclusive(sFile As String) As Boolean
Dim nFile As Integer
nFile = FreeFile
On Error GoTo QH
Open sFile For Binary Access Read Lock Write As nFile
Close nFile
pvCanOpenExclusive = True
QH:
End Function
Nice side-effect is that even if zipping fails this will not end up in infinite loop.
The trouble comes when accessing the zip-file when it's closed by zipfldr.dll, that is when pvCanOpenExclusive returns true.
You are correct, CopyHere is asynchronous.
When I do this in a vbscript, I sleep until the count of files in the zip, is greater than or equal to the count of files copied in.
Sub NewZip(pathToZipFile)
WScript.Echo "Newing up a zip file (" & pathToZipFile & ") "
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim file
Set file = fso.CreateTextFile(pathToZipFile)
file.Write Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0)
file.Close
Set fso = Nothing
Set file = Nothing
WScript.Sleep 500
End Sub
Sub CreateZip(pathToZipFile, dirToZip)
WScript.Echo "Creating zip (" & pathToZipFile & ") from (" & dirToZip & ")"
Dim fso
Set fso= Wscript.CreateObject("Scripting.FileSystemObject")
If fso.FileExists(pathToZipFile) Then
WScript.Echo "That zip file already exists - deleting it."
fso.DeleteFile pathToZipFile
End If
If Not fso.FolderExists(dirToZip) Then
WScript.Echo "The directory to zip does not exist."
Exit Sub
End If
NewZip pathToZipFile
dim sa
set sa = CreateObject("Shell.Application")
Dim zip
Set zip = sa.NameSpace(pathToZipFile)
WScript.Echo "opening dir (" & dirToZip & ")"
Dim d
Set d = sa.NameSpace(dirToZip)
' for diagnostic purposes only
For Each s In d.items
WScript.Echo s
Next
' http://msdn.microsoft.com/en-us/library/bb787866(VS.85).aspx
' ===============================================================
' 4 = do not display a progress box
' 16 = Respond with "Yes to All" for any dialog box that is displayed.
' 128 = Perform the operation on files only if a wildcard file name (*.*) is specified.
' 256 = Display a progress dialog box but do not show the file names.
' 2048 = Version 4.71. Do not copy the security attributes of the file.
' 4096 = Only operate in the local directory. Don't operate recursively into subdirectories.
WScript.Echo "copying files..."
zip.CopyHere d.items, 4
Do Until d.Items.Count <= zip.Items.Count
Wscript.Sleep(200)
Loop
End Sub
You can try accessing the file you've just copied, for example with an "exists" check:
For Each file In folderToZip.Items
For Each extension In fileExtensions
If LCase(oFSo.GetExtensionName(file)) = LCase(extension) Then
zipFile.CopyHere(file)
Dim i: i = 0
Dim target: target = oFSO.BuildPath(zipFile, oFSO.GetFileName(file))
While i < 100 And Not oFSO.FileExists(target)
i = i + 1
WScript.Sleep 10
Wend
Exit For
End If
Next
Next
I'm not sure if target is calculated correctly for this use context, but you get the idea. I'm a bit surprised that this error occurs in the first place... FileSystemObject should be strictly synchronous.
If all else fails, do this:
For Each file In folderToZip.Items
For Each extension In fileExtensions
If LCase(oFSo.GetExtensionName(file)) = LCase(extension) Then
CompressFailsafe zipFile, file
Exit For
End If
Next
Next
Sub CompressFailsafe(zipFile, file)
Dim i: i = 0
Const MAX = 100
On Error Resume Next
While i < MAX
zipFile.CopyHere(file)
If Err.Number = 0 Then
i = MAX
ElseIf Err.Number = xxx ''# use the actual error number!
Err.Clear
WScript.Sleep 100
i = i + 1
Else
''# react to unexpected error
End Of
Wend
On Error GoTo 0
End Sub
The solution we used after much debugging and QA on various windows flavours, including fast and slow machines and machines under heavy CPU load was the following snippet.
Critique and improvements welcome.
We were not able to find a way of doing this without a loop, that is, if you wanted to do some validation or post zipping work.
The goal was to build something that ran reliably on as many windows flavours as possible. Ideally as natively as possible too.
Be advised that this code is still is NOT 100% reliable but its seems to be ~99%. As stable as we could get it with the dev and QA time available.
Its possible that increasing iSleepTime could make it 100%
Points of note:
The unconditional sleep seems to be the most reliable and compatible approach we found
The iSleepTime should not be reduced, it seems the more frequently the loop runs, the higher the probability of an error, seemingly related to the internal operations of the zip/copy process
iFiles is the source file count
The more simplistic the loop was, the better, for example outputting oZippp.Items().Count in the loop caused inexplicable errors that looked like they could be related to file access/sharing/locking violations. We didn't spend time tracing to find out.
It seems on Windows 7 anyway, that the internals of the zipping process use a temp file located in the cwd of the compressed zip folder, you can see this during long running zips by refreshing your explorer window or listing dir with cmd
We had success with this code on Windows 2000, XP, 2003, Vista, 7
You'd probably want to add a timeout in the loop, to avoid infinite loops
'Copy the files to the compressed folder
oZippp.CopyHere oFolder.Items()
iSleeps = 0
iSleepTime = 5
On Error Resume Next
Do
iSleeps = iSleeps + 1
wScript.Sleep (iSleepTime * 1000)
Loop Until oZippp.Items().Count = iFiles
On Error GoTo 0
If iFiles <> oZippp.Items().Count Then
' some action to handle this error case
Else
' some action to handle success
End If
Here is a trick I used in VB; get the length of the zip file before the change and wait for it to change - then wait another second or two. I only needed two specific files but you could make a loop out of this.
Dim s As String
Dim F As Object 'Shell32.Folder
Dim h As Object 'Shell32.Folder
Dim g As Object 'Shell32.Folder
Dim Flen As Long, cntr As Long, TimerInt As Long
Err.Clear
s = "F:\.zip"
NewZipFolder s
Flen = FileLen(s)
Set F = CreateObject("Shell.Application").namespace(CVar(s))
TimerInt = FileLen("F:\MyBigFile.txt") / 100000000 'set the loop longer for bigger files
F.CopyHere "F:\DataSk\DemoData2010\Test.mdf"
Do
cntr = Timer + TimerInt
Do
DoEvents: DoEvents
Loop While cntr > Timer
Debug.Print Flen
Loop While Flen = FileLen(s)
cntr = Timer + (TimerInt / 2)
Do
DoEvents: DoEvents
Loop While cntr > Timer
Set F = Nothing
Set F = CreateObject("Shell.Application").namespace(CVar(s))
F.CopyHere "F:\MynextFile.txt"
MsgBox "Done!"

Progress Bar and File Copying Problem?

Using VB 6
In my Project, when I copy the file from one folder to another folder, at the time I want to show the progress bar like copying…., Once the file was copied the Progress bar show’s 100 % Completed.
Code.
'File Copying
Private Sub Copy_Click()
Timer1.Enabled = True
Dim abc As Integer
Dim line As String
abc = FreeFile
Open App.Path & "\DatabasePath.TXT" For Input As #abc
Input #abc, line
databasetext = line
Dim fs As New FileSystemObject, f As File
Set f = fs.GetFile(databasetext)
f.Copy App.Path & "\"
Set fs = Nothing
Close #abc
End Sub
Private Sub Timer1_Timer()
ProgressBar1.Min = 0
ProgressBar1.Max = 100
ProgressBar1.Value = ProgressBar1.Value + 1
If ProgressBar1.Value = ProgressBar1.Max Then
Timer1.Enabled = False
End If
End Sub
Above code Is working, But when I click copy button, Progressbar1 is not displaying, once the file was copied to another folder. Then only progressbar1 is stating.
Both will not working simultaneously.
And Also Once the file was copied, then progress bar should display 100 %. Now it is not displaying correctly, Still the file is copying, Progress bar is showing 100 %
Can any one help to solve the problem.
Need VB 6 Code Help.
If the standard copy function is blocking the timer from firing then the best thing you can do is write your own copy which reads the source file a few thousand bytes at a time and writes it to the destination file.
Between each read and write operation you need to update your progress bar and (possibly) call DoEvents to make sure it redraws.
Also your timer code makes no sense. It just arbitrarily increases progress every time if fires without reference to how much progress has actually been made. You would be better off passing the progress bar to your copy function so that it can updated as you go.
Something like this would do it:
Private Sub Copy_Click()
Dim abc As Integer
Dim line As String
abc = FreeFile
Open App.Path & "\DatabasePath.TXT" For Input As #abc
Input #abc, line
copyFile line, App.Path & "\" & line, ProgressBar1
Close #abc
End Sub
Sub copyFile(inFile As String, outFile As String, ByRef pg As ProgressBar)
Close
Const chunkSize = 1024
Dim b() As Byte
fhIn = FreeFile
Open inFile For Binary Access Read As #fhIn
fhOut = FreeFile
Open outFile For Binary Access Write As #fhOut
toCopy = LOF(fhIn) 'gets the size of the file
fileSize = toCopy
pb.Min = 0
pb.Max = toCopy
While toCopy > 0
If toCopy > chunkSize Then
ReDim b(1 To chunkSize)
toCopy = toCopy - chunkSize
Else
ReDim b(1 To toCopy)
toCopy = 0
End If
Get #fhIn, , b
Put #fhOut, , b
pg.Value = fileSize - toCopy
DoEvents
Wend
Close #fhIn
Close #fhOut
End Sub
For a progress bar to function, it either has to be updated inline with a periodic loop, or run in a separate thread.
The copy in old school VB6 is a blocking command. So even DoEvents will give the same result (the file will copy, then the progress bar will show up). If you are copying large files over a slow medium and you need to be able to show progress, then you should create the target file and move over bytes in chunks in a loop, in that loop you could update your progress bar. Sadly for the example given in the OP you won't get what you are looking for since every operation is synchronous.
EDIT: Beaten by the guy above me :)

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