Use VBscript to paste data into a txt file and save - vbscript

I need to paste data from clipboard (Ctrl+V) into a text file and save it.
I already did some research and it seems that a text file doesn't have a method like SaveAs.
With code below, I could create a new text file and paste data into it, but I can't Save it:
Set WShshell = CreateObject("WScript.Shell")
WShshell.run "c:\WINDOWS\system32\notepad.exe",1
WshShell.AppActivate "notepad"
WShshell.SendKeys "^V"
I understand there is a method called CreateTextFile, but seems I can't perform paste with it.
I also tried to combine those two:
Set WShshell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CreateTextFile "c:\1.txt",true
WshShell.AppActivate "notepad"
WShshell.SendKeys "^V"
But nothing happened...

UFT has its own clipboard access methods you could use. Here I've created an instance of the clipboard, and extracted its content into sText, then created a text file in C:\temp and written the data from the clipboard directly into it. oFile.Close closes the file and saves it at the same time.
Dim oClipboard : Set oClipboard = CreateObject("Mercury.Clipboard")
sText = oClipboard.GetText ' gets the current content of the clipboard
Dim oFso : Set oFso = CreateObject("Scripting.FileSystemObject")
Dim oFile : Set oFile = oFso.CreateTextFile("C:\temp\myTextFile.Txt", True)
oFile.Write sText
oFile.Close

I took a stab at it... This was my successful result.
I also noted that this script got really angry when another notepad was already opened.
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Set WShshell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
'Gets user profile variable with CMD
UserProfile = CreateObject("WScript.Shell").Exec("cmd /c echo.%USERPROFILE%").Stdout.ReadAll
'Creates temporary files in appdata\local\temp
'--------------------------------------------------------------------------------------
tmpfilename = fso.GetTempName
tmpfile = Replace(UserProfile & "\AppData\Local\Temp\" & tmpfilename, vbcrlf, "")
Set CreateTempFile = FSO.OpenTextFile(tmpfile, forwriting, true) : CreateTempFile.Close
'Creates a new file for the pasted content
'--------------------------------------------------------------------------------------
MyFile = ThisFolder & "ClipBoard_Extract_" & _
Replace(FormatDateTime(Cdate(now),2), "/", "-") & "_" & _
Hour(now) & Minute(Now) & Second(now) & ".txt"
'Execute's the Main Sub but you could get along without it.
' I usually build my scripts to scale and do logging and other magical things.
'--------------------------------------------------------------------------------------
MainScript
Sub MainScript()
CaptureClipboardText
ExtractTempFile
End Sub
Sub CaptureClipboardText
WShshell.run "c:\WINDOWS\system32\notepad.exe " & tmpfile, 1
WshShell.AppActivate "Notepad"
wscript.sleep 1000
WShshell.SendKeys "^V"
WShshell.SendKeys "^S"
Wshshell.SendKeys "%F"
Wshshell.SendKeys "x"
Wshshell.SendKeys "s"
wscript.sleep 1000
End Sub
Sub ExtractTempFile
Set Extract = fso.OpenTextFile(tmpfile, ForReading)
Set Output = fso.OpenTextFile(MyFile, ForWriting, True) 'True on this syntax means - Create the file if it doesn't exist.
Do Until Extract.AtEndofSTream
line = Extract.Readline
Output.Writeline Line
Loop
Extract.Close : Set Extract = Nothing
fso.DeleteFile tmpfile, true
End Sub
Function ThisFolder
ThisFolder = Left(Wscript.ScriptFullName, Len(Wscript.ScriptFullName) - Len(Wscript.ScriptName))
End Function
Cheers!

Related

Long Path Problem using WScript.Arguments

In continuation of Call VBScript from Windows Explorer Context Menu, I managed to get a VBScript file running from SendTo in the Windows Explorer.
I've changed my code to copy the file that invokes the script to my Temp folder. The new problem is that if the path is over 256 characters, I can't loop through WScript.Arguments to get all of it. Is there another way to get the full path (including the file name and it's extension)?
Option Explicit
Call OpenDocuWorksFile
Sub OpenDocuWorksFile()
Const sTitle = "Open DocuWorks File"
Dim iArgumentsCount
Dim iArgument
Dim sFilePath
Dim sTempFolder
Dim oFileScriptingObject
Dim sFileName
Dim oShell
iArgumentsCount = WScript.Arguments.Count
On Error Resume Next
For iArgument = 0 To iArgumentsCount
sFilePath = sFilePath & WScript.Arguments(iArgument)
Next
On Error GoTo 0
Set oFileScriptingObject = CreateObject("Scripting.FileSystemObject")
With oFileScriptingObject
sFileName = .GetFileName(sFilePath)
sTempFolder = oFileScriptingObject.GetSpecialFolder(2) 'Temp Folder
If .GetExtensionName(sFileName) = "xdw" Then
.CopyFile sFilePath, sTempFolder & "\", True 'Overwrite
Set oShell = CreateObject("Shell.Application")
oShell.Open sTempFolder & "\" & sFileName
Else
MsgBox "Please select a DocuWorks file.(.xdw)", vbCritical, sTitle
End If
End With
Set oFileScriptingObject = Nothing
Set oShell = Nothing
End Sub

VBScript Using Computername to Name a File

New to VBScript and having a problem grasping this concept.
This is the code:
Set WshNetwork = WScript.CreateObject("WScript.Network")
strCompName = WshNetwork.Computername
Wscript.Echo WshNetwork.Username >j:\strCompName.txt
WScript.Quit()
Basically I want to the username dumped to a text file and the text file should be named with the name of the computer. I've tried putting the strCompName in quotes, single quotes, parenthesis with no success.
Here is the code that you can use. You need to use FileSystemObject. The FileSystemObject is used to gain access to a computer's file system. It can create new files and access existing ones.
Set WshNetwork = WScript.CreateObject("WScript.Network")
Set objFSO = CreateObject("Scripting.FileSystemObject")
strCompName = WshNetwork.Computername
'writing to file
outFile="c:\TEMP\" & strCompName & ".txt"
Set objFile = objFSO.CreateTextFile(outFile,True)
objFile.Write WshNetwork.Username & vbCrLf
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing
Set WshNetwork = Nothing
WScript.Quit()
Save this in .vbs file and run and you will get a text file with computer name in TEMP folder (Change the path if you like).
This code should work. This code opens the file and appends it if the file exists or creates a file and writed to it if it does not exist.
'constants
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
'Load domain, username, & computer variables
Set oShell = CreateObject( "WScript.Shell" )
sDomain = oShell.ExpandEnvironmentStrings( "%USERDOMAIN%" )
sUserName = oShell.ExpandEnvironmentStrings( "%USERNAME%" )
sComputer = oShell.ExpandEnvironmentStrings( "%COMPUTERNAME%" )
'Setup filesystemobject
Set oFSO=CreateObject("Scripting.FileSystemObject")
'Check to see if file exists. If exists open it forAppending
'else create file and write to it.
outFile="c:\export\" & sComputer & ".txt"
If oFSO.FileExists(outFile) Then
Set objFile = oFSO.OpenTextFile(outFile, ForAppending, True, TristateTrue)
Else
Set objFile = oFSO.CreateTextFile(outFile,True)
End If
'write to file
objFile.WriteLine sDomain & "\" & sUsername & " - " & Now
'clean up objects
objFile.Close
Set objFile = Nothing
Set oFSO = Nothing
Set oShell = Nothing

VBScript record command line output to text (log) file

I've looked over all the redirect/export command line to text file answers, but none work in this case. I am testing our software and need to run the application using several XML files. I've written the VBScript to run all XML in a folder against the application, but I need to capture everything in the command window to a text file (run.log).
Here is what I have cobbled together:
Option Explicit
Dim FSO, FLD, FIL, str, Expath, strFolder, objShell, objFSO, strFile, objFile
set objShell = WScript.CreateObject ("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
'defines values
strFile = "Run.log"
strFolder = "C:\SDK Testing PDFL 10\XML\"
Expath = "C:\Program Files\ICEsdk600022\bin\FineEyeProcessExe.exe"
objShell.CurrentDirectory = "C:\SDK Testing PDFL 10"
'defines the directory where the XML resides
set FLD = FSO.GetFolder(strFolder)
'defines loop parameters
For Each Fil In FLD.Files
'searches for XML files within loop
If UCase(FSO.GetExtensionName(Fil.name)) = "XML" Then
'builds commandline
str = chr(34) & Expath & chr(34) & chr(32) & chr(34) & strFolder & Fil.Name & chr(34)
'writes string to log
set objFSO = CreateObject("Scripting.FileSystemObject")
set objFile = objFSO.OpenTextFile(strFolder & strFile, 8, True)
objFile.WriteLine(str)
objFile.Close
'runs command
objShell.Run str
'shows string
MsgBox str
'writes output to log
'set objFSO = CreateObject("Scripting.FileSystemObject")
'set objFile = objFSO.OpenTextFile(strFolder & strFile, 8, True)
'objFile.WriteLine()
'objFile.Close
End If
Next
You could modify this line..
objShell.Run str
..to something like this..
objShell.Run "cmd /c " & str & " > log.txt"
That will dump the output of C:\Program Files\ICEsdk600022\bin\FineEyeProcessExe.exe to log.txt

I am trying to find specific links on users desktops and create a file logging the results

I have used similar before and I have local admin rights on every computer in our network. The following code generates an error on line 16 char 1.
line 16 For Each objsubfolder In objFSO.GetFolder("\" & strComputer & "%HOMEPATH%").subfolders
If the file exists it should write a line in the text file to indicate so for each user with a profile. If the file doesn't exist is should write a line in the same text file.
The error I get is Path not found 800A004C.
The computers.txt file contains a list of all the computers I want to check.
InputFile = "computers.txt"
Const DeleteReadOnly = True
Const ForAppending = 8
Dim goFS : Set goFS = CreateObject("Scripting.FileSystemObject")
Dim gsLog : gsLog = ".\logdemo.log"
WScript.Echo gsLog, "exists:", CStr(goFS.FileExists(gsLog))
' .OpenTextFile(filename[, iomode[, create[, format]]])
Dim goLog : Set goLog = goFS.OpenTextFile(gsLog, ForAppending, True)
goLog.WriteLine Now & " start"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(InputFile)
Do While Not (objFile.AtEndOfStream)
strComputer = objFile.ReadLine
For Each objsubfolder In objFSO.GetFolder("\\" & strComputer & "%HOMEPATH%").subfolders
If objFSO.FileExists(objsubfolder.Path & "\desktop\program1.LNK") Then
golog.WriteLine Join(Array(Now, strComputer, objsubfolder, "This Computer has Program 1"))
Else
golog.WriteLine Join(Array(Now, strComputer, objsubfolder, "None"))
End If
Next
Loop
golog.WriteLine Now & " End"
golog.WriteLine "-----------------------------------------------------------"
golog.Close
MsgBox "Done"
To prove that the FSO does not expand environment strings automagically:
Dim oFS : Set oFS = CreateObject("Scripting.FileSystemObject")
Dim oWS : Set oWS = CreateObject("WScript.Shell")
Dim sPath
sPath = "%windir%\addins"
WScript.Echo qq(sPath), CStr(oFS.FolderExists(sPath))
sPath = oWS.ExpandEnvironmentStrings("%windir%\addins")
WScript.Echo qq(sPath), CStr(oFS.FolderExists(sPath))
output:
"%windir%\addins" False
"C:\WINDOWS\addins" True
So put some work into feeding a valid path to .GetFolder().

Delete shortcut from remote computers with multiple users

Warning I have zero VB knoeledge
So I found this handy script this morning:
InputFile = "C:\MachineList.Txt"
Const DeleteReadOnly = True
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(InputFile)
Do While Not (objFile.AtEndOfStream)
strComputer = objFile.ReadLine
On Error Resume Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFile("\\" & strComputer & "\c$\Documents and Settings\all users\Desktop\Malwarebytes Anti-Malware.LNK")
Err.Clear
Loop
MsgBox "Done"
It did the job great. The problem I am facing is the shortcut is not always under all users or their name lets call it user1
So I would love for it to go through MachineList.txt and browse through all of the profiles searching for Malwarebytes Anti-Malware.LNK. I have seen a few scripts on this but I just cannot wrap my head around VB is a short amount of time. I appreciate any input.
I assume that what you provided results in valid paths... therefore this should work:
InputFile = "C:\MachineList.Txt"
Const DeleteReadOnly = True
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(InputFile)
Do While Not (objFile.AtEndOfStream)
strComputer = objFile.ReadLine
For Each objsubfolder In objFSO.GetFolder("\\" & strComputer & "\c$\Documents and Settings\").subfolders
If objFSO.FileExists(objsubfolder.Path & "\desktop\Malwarebytes Anti-Malware.LNK") Then
objFSO.DeleteFile (objsubfolder.Path & "\desktop\Malwarebytes Anti-Malware.LNK")
End If
'To check another file uncomment this
'Add as many of these as you like here
'If objFSO.FileExists(objsubfolder.Path & "\desktop\Otherfile.LNK") Then
' objFSO.DeleteFile (objsubfolder.Path & "\desktop\Otherfile.LNK")
'End If
Next
Loop
MsgBox "Done"

Resources