Word document mysteriously write protected? - vbscript

I am trying to do a find and replace operation on several Word documents in a folder. I wrote the following VBScript to do that:
Option Explicit
Dim Word, Document, FolderPath, FileSystem, FileList, File, Doc, InfoString
Const ReadOnly = 1
Const wdFindContinue = 1
Const wdReplaceAll = 2
Const wdOriginalDocumentFormat = 1
Set FileSystem = CreateObject("Scripting.FileSystemObject")
FolderPath = FileSystem.GetAbsolutePathName(".")
Set FileList = FileSystem.GetFolder(FolderPath).files
Set Word = CreateObject("Word.Application")
Word.Visible = False
Word.DisplayAlerts = False
For Each File in FileList
If LCase(Right(File.Name,3)) = "doc" Or LCase(Right(File.Name,4)) = "docx" Then
If File.Attributes And ReadOnly Then
File.Attributes = File.Attributes - ReadOnly
End If
Set Doc = Word.Documents.Open(File.Path,,True)
' find and replace stuff
End If
Next
Word.Documents.Save True, wdOriginalDocumentFormat
Word.Quit
MsgBox("Done")
Problem is, when it reaches the line Word.Documents.Save, a Save As dialog box always pops up. If I click Cancel, I get an error from Windows Script Host saying the file is write protected, even though it is not shown as write protected if I open the Properties dialog in File Explorer. If I click save, I am prompted to save all the other files too. What is the problem here?
I have a suspicion that it is caused by the Word documents being very old, like from the 1990s.

Set Doc = Word.Documents.Open(File.Path,,True)
and look at the docs from Object Browser.
Function Open(FileName, [ConfirmConversions], [ReadOnly], [AddToRecentFiles], [PasswordDocument], [PasswordTemplate], [Revert], [WritePasswordDocument], [WritePasswordTemplate], [Format], [Encoding], [Visible], [OpenAndRepair], [DocumentDirection], [NoEncodingDialog]) As Document
Member of Word.Documents
So the True says to open Read Only. This is Word's read only, nothing to do with the file.

Related

Let user pick directory of where a created text file is placed

How do I take the user input and let that be the directory for a text file?
I tried putting quotes around the ("Inp.txt") but this doesn't read the actual user input.
Set oFSO = CreateObject("Scripting.FileSystemObject")
Inp= InputBox("Please Enter Desired Location of Log File:")
If Inp= "" Then
Set oTF = oFSO.CreateTextFile("C:\Old Files.txt")
Else
Set oTF = oFSO.CreateTextFile(Inp.txt)
End If
I want to prompt the user for an input asking where they'd like to place their created text file; if left blank i would set it to a default location. I tried setting an inputbox prompt but when i use that as the text file location I receive an "Object Required" runtime error.
Build a complete path from the directory and a file name:
Set oTF = oFSO.CreateTextFile(oFSO.BuildPath(Inp, "output.txt"))
I would recommend letting the users browse for the folder, though.
Set app = CreateObject( "Shell.Application" )
Set d = app.BrowseForFolder(0, "Select Folder", 1, "C:\")
If d Is Nothing Then
Inp = "C:\"
Else
Inp = d.Self.Path
End If
Set oTF = oFSO.CreateTextFile(oFSO.BuildPath(Inp, "output.txt"))

How to save a file with password in UFT

I am using UFT 12.5. During run time it opens excel and word. Then it writes some data in the both files. After that, I would like to save both files with a new name and then password protected. I need to be able to enter password manually to open it. So far, I have written the below code and I getting an error at the last line.
Set ExcelObj = createobject("excel.application")
ExcelObj.Visible = true
Set ExcelFile = ExcelObj.Workbooks.Open (file)
Set ScripSheet = ExcelFile.Worksheets("Scripts")
ScripSheet.Cells(1,1) = "Passed"
ExcelFile.SaveAs mm1, "ttt"
Please advise on how I can save word and excel files with a password using UFT.
Thanks.
You need to pass correct parameters with SaveAs method. Check this link for more info.
Here is the working code that you can try:
file = "File path with file name"
newfile = "File path with new file name"
Set ExcelObj = createobject("excel.application")
ExcelObj.Visible = true
Set ExcelFile = ExcelObj.Workbooks.Open (file)
Set ScripSheet = ExcelFile.Worksheets("Scripts")
ScripSheet.Cells(1,1) = "Passed"
ExcelFile.SaveAs newfile, , "test"
ExcelFile.Close
ExcelObj.Quit
UPDATE
Per comments from OP
If you want to save file with ReadOnly, you have to use WriteResPassword parameter this way:
ExcelFile.SaveAs newfile, , , "test"
Note that I've two empty parameters for FileFormat and
Password respectively.
This way it will ask for password to open the file in write mode and if you won't provide the password, file will be opened in ReadOnly
mode.
Check the link that I've mentioned.

Use VBScript to show properties dialog/sheet - for multiple items

I'm trying to write a script in VBS to show the file properties dialog/sheet for multiple items. Those items will be all of the items in a parent folder (e.g. all items in W:\).
Essentially, I'm trying to get the properties dialog to show the number of files in a drive. Right-clicking on the drive and selecting Properties does not show the number of files. You would instead need to go into the first level of the drive, select all folders/files, and then right-click and select Properties.
I have customised some code (below) I've found on the internet to bring up the file properties dialog/sheet for either a specific folder, or a drive. I have no idea what I could further change to get the properties dialog for all files and folder of a specified drive. Perhaps getting all folders/files of the drive into an array and then working with that?
Please note I'm looking for the actual properties dialog, and not just a simple return of the total number of files (I know how to do this).
Any help would be appreciated! Thanks :)
Code:
dim objShell, objFSO, folParent, sParent, filTarget, sFileName, sOutput, fivVerbs, iVerb, vVerb, fvbVerb, testItemsParent, TestMappedDestination
set objFSO = CreateObject("Scripting.FileSystemObject")
set objShell = CreateObject("Shell.Application")
const mappedDestination = "c:\"
vVerb = "P&roperties"
sParent = objFSO.GetParentFolderName(mappedDestination)
sFileName = objFSO.GetFileName(mappedDestination)
If Len(mappedDestination) = 3 then
nsTarget = &H11
TestMappedDestination = "(" & UCase(Left(mappedDestination,2)) & ")"
Else
nsTarget = sParent
TestMappedDestination = UCase(sFileName)
End If
set folParent = objShell.Namespace(nsTarget)
For each filTarget in folParent.Items
If Len(mappedDestination) = 3 then
testItemsParent = UCase(Right(filTarget,4))
Else
testItemsParent = UCase(filTarget)
End if
If testItemsParent = TestMappedDestination then
Set fivVerbs = filTarget.Verbs
For iVerb = 0 to fivVerbs.Count - 1
If fivVerbs.Item(iVerb).Name = vVerb then
Set fvbVerb = fivVerbs.Item(iVerb)
fvbVerb.DoIt()
filTarget.InvokeVerbEx fvbVerb.Name, ""
Msgbox "Placeholder msgbox to keep properties dialog/sheet from disappearing on script completion"
Exit for
End if
Next
Exit for
End if
Next

AutoExport Run Results from UFT Function

I am running an automated test script using UFT 12.52. I am wondering if there is a way to export results from within a function in the UFT Script. The idea is to call the function and export the run results.
I can do it externally by creating a .vbs file which launches the script in uft and runs and exports the result, but i cannot figure out how to do it from within a UFT Script as function.
Below is my code for exporting results externally.
Thanks
Dim qtApp
Dim qtTest
Dim qtResultsOpt
Dim qtAutoExportResultsOpts
Set qtApp = CreateObject("QuickTest.Application")
qtApp.Launch
qtApp.Visible = True
qtApp.Options.Run.ImageCaptureForTestResults = "OnError"
qtApp.Options.Run.RunMode = "Fast"
qtApp.Options.Run.ViewResults = False
qtApp.Open "Z:\D:\paperlessEnhancements\", True
Set qtTest = qtApp.Test
qtTest.Settings.Run.IterationMode = "rngIterations"
qtTest.Settings.Run.StartIteration = 1
qtTest.Settings.Run.EndIteration = 1
qtTest.Settings.Run.OnError = "NextStep"
Set qtResultsOpt = CreateObject("QuickTest.RunResultsOptions")
qtResultsOpt.ResultsLocation = "C:\Tests\Test1\Res1" n
Set qtAutoExportResultsOpts = qtApp.Options.Run.AutoExportReportConfig
qtAutoExportResultsOpts.AutoExportResults = True
qtAutoExportResultsOpts.StepDetailsReport = True
qtAutoExportResultsOpts.DataTableReport = True
qtAutoExportResultsOpts.LogTrackingReport = True
qtAutoExportResultsOpts.ScreenRecorderReport = True
qtAutoExportResultsOpts.SystemMonitorReport = False
qtAutoExportResultsOpts.ExportLocation =
"C:\Documents and Settings\All Users\Desktop"
qtAutoExportResultsOpts.UserDefinedXSL = "C:\Documents and Settings\All
Users\Desktop\MyCustXSL.xsl"
qtAutoExportResultsOpts.StepDetailsReportFormat = "UserDefined"
qtAutoExportResultsOpts.ExportForFailedRunsOnly = True
qtTest.Run qtResultsOpt
MsgBox qtTest.LastRunResults.Status
qtTest.Close
Set qtResultsOpt = Nothing
Set qtTest = Nothing
Set qtApp = Nothing
Set qtAutoExportSettings = Nothing
I also tried this :
Dim qtResultsOpt
Dim qtAutoExportResultsOpts
Set qtResultsOpt = CreateObject("QuickTest.RunResultsOptions")
qtResultsOpt.ResultsLocation = "C:\Temp\Notepad1"
Set qtResultsOpt = Nothing
#Lukeriggz :Attach a function library to all your script and the function library should be called in first place in your script(Either you can call the lines in your current library function itself. But the significance is to set the attribute at the first place and start with the execution). The content of the library should be the one which you have shown the code except the Open,run statement and releasing the objects(Primarily the configuration statements should be there). This will make your result location always pointed to your desired path and you can view the results. While configuration of the script have the script name in a variable to create the result file name to act is as dynamic
Another Implementation
We can easily identify where the results are getting saved Using the inbuilt environment variable. So programmatically we can copy the folder using file system objects
enter code here
executionpath=Environment.Value("ResultDir")
path_to_save_the_results= "Type your path where the results should be saved"
fso.CopyFolder executionpath, path_to_save_the_results

Replacing SubString values with the Replace function

The code below looks in the test folder for any files that have not been accessed in over 5 days, if it finds one it assigns mRoot the file path and then whats NOT WORKING is using the Replace method to look inside the mRoot string for the IP and replace it with the new one, I have it show me what mRoot looks like in a pop up just to make sure it changes(or doesn't). I can't seem to get the IP to change. Can anyone help out? I'm very new to VBS so I'm hoping this is obvious (whether it is doable or not). Thanks.
Set oFileSys = WScript.CreateObject("Scripting.FileSystemObject")
sRoot = "\\192.168.1.104\test\"
today = Date
Set aFolder = oFileSys.GetFolder(sRoot)
Set aFiles = aFolder.Files
For Each file in aFiles
FileAccessed = FormatDateTime(file.DateLastAccessed, "2")
If DateDiff("d", FileAccessed, today) > 5 Then
Set objShell = Wscript.CreateObject("Wscript.Shell")
mRoot = file
Call Replace(mRoot,"\\192.168.1.104","\\192.168.1.105")
objShell.Popup mRoot,, "My Popup Dialogue box"
'oFileSys.MoveFile file, mRoot
End If
Next
Try mRoot = Replace(mRoot,"\\192.168.1.104","\\192.168.1.105")

Resources