VBS / Making Word Document Visible - vbscript

I have a simple script that I would like to run and it check to see if there's a word document open, and if it's open, then make it visible. It can be ANY word document, so I can't make it specifically to any file name.
Here's the code so far:
Dim Word
Set Word = GetObject(, "Word.Application")
If Word Is Nothing Then
MsgBox "Is not running"
Else
MsgBox "Is running"
Word.Visible = True
End If
Everything works except for Word.Visible = True. The popup shows "Is running" but the word document isn't brought to the front, selected or made visible at all. What am I missing? Thanks!
Updated details:
I've even tried it like this...
Dim Word
Set Word = GetObject(, "Word.Application")
Word.Visible = True
Word.Selection.TypeText "Hello Word"
With this code...As long as Word is currently opened, it should make it visible, then write Hello Word. It does write Hello Word, but doesn't make it visible. One I run it, I can see Word flashing in my task bar because Hello Word was added, but still doesn't make it visible. Hope that helps!

It seems you're misunderstanding how the Visible property works. That property defines if the application is visible at all or not (as in "does or doesn't show up in the taskbar").
Apparently your application already is visible (otherwise you wouldn't be able to see it flashing in the taskbar), but what you actually want is to un-minimize it and bring it to the front. The WindowState property should do that for you:
Const wdWindowStateNormal = 0
Const wdWindowStateMaximize = 1
Const wdWindowStateMinimize = 2
Set wd = GetObject(, "Word.Application")
If wd Is Nothing Then
MsgBox "Is not running"
Else
MsgBox "Is running"
wd.WindowState = wdWindowStateNormal
End If

Set oWord = CreateObject ("Word.Application")
oWord.Visible = True

Related

How to Maximize Screen from VBScript?

The web application that displays database information is much more readable in full-screen mode rather than a small window. Problem is, I cannot get the window to maximize from UFT/QTP.
I've tried running the browser object from Wscript.Shell, but the application returns to UFT and maximizes that window instead of the newly created browser window.
siteA = "https://google.com"
Const max_window = 3
Set browobj = CreateObject("Wscript.Shell")
Set oShell = CreateObject("WScript.Shell")
'browobj.Run "chrome -k -incognito -url "&siteA
browobj.Run "chrome -incognito -url "&siteA, max_window
oShell.SendKeys "% x"
browobj.sendkeys "{F9}"
browobj.sendkeys "(% )X"
browobj.SendKeys "% x"
Set browobj = Nothing
Any solutions to maximizing the window with the focus object of the new browser?
Edit:
Even below will not maximize taken from this List of Controls is not working.
SystemUtil.Run "chrome.exe" , siteA ,,,3
chrome.exe --incognito --start-maximized
If you shut down all instances of chrome these controls work fine, but if you have an active window in chrome it will take those properties.
We have a function defined during our browser login process that grabs the window and maximises it so that our UFT processes run with a (nearly) full screen browser - we don't need to hide the menu bar etc. This is the function we are using:
Public Function MISC_MaximiseBrowser(ByVal oBrowser, ByRef ErrorMsg)
LOG_Write vbNewLine & "MISC_MaximiseBrowser"
LOG_Write "oBrowser: " & oBrowser.GetROProperty("TestObjectName")
Dim Hwnd
dim bIsMax, bIsMaxable
MISC_MaximiseBrowser = True
Hwnd = oBrowser.Object.HWND
If Window("hwnd:=" & Hwnd).GetROProperty("maximized") Then
bIsMax = True
Else
bIsMax = False
End If
If Window("hwnd:=" & Hwnd).GetROProperty("maximizable") Then
bIsMaxable = True
Else
bIsMaxable = False
End If
If Not bIsMax And bIsMaxable Then
Window("hwnd:=" & Hwnd).Maximize
End If
End Function
What this does is accepts the Browser UFT object you're working with and grabs the handle for it. If the browser is not already maximized and it's possible to maximize it, it will do so.
You can ignore the LOG_Write statements at the start of the function - those are for our internal logging steps

Window("hwnd:=" & handle).Restore is causing Object not visible error

I have an application that opens up some new tabs. I'm trying to cycle through these tabs, look at them, and then close them.
Dim tab_children, oDesc
Set oDesc = Description.Create
oDesc("micclass").value = "Browser"
Set tab_children = Desktop.ChildObjects(oDesc)
Dim title, handle, cTime
For i = 0 To tab_children.Count-1 Step 1
title = tab_children(i).GetROProperty("title")
handle = tab_children(i).GetROProperty("hwnd")
Window("hwnd:=" & handle).Restore
msgbox title & ": " & handle
Next
When we try to execute the .Restore, I receive an "object not visible" error. The tab that we're trying to restore is not the one that has focus, could that be the issue and if so how can we resolve it? I was under the impression that .Restore would bring that tab into focus based off of this thread, http://www.advancedqtp.com/old_forums/viewtopic.php?t=1970
The IDE I'm using is QTP, the Browser is IE.
A potential work around that I've been thinking about:
After the application opens up the new tabs, the last opened tab has focus. If we close that one, the 2nd to last has focus, all the way down to the original application's tab. Perhaps there's a way to utilize this information.
Restore has worked for me in the past, try using Activate-
Window("hwnd:=" & handle).Activate
Edited: Just tested the following and its working on my machine-
'Create Browser Descriptor
Set oBrowser=Description.Create
oBrowser("micclass").Value="Browser"
'Get the child objects
Set oBrowser=Desktop.ChildObjects(oBrowser)
totalcount = oBrowser.Count-1
For i=0 to totalcount
If Browser("micclass:=Browser", "index:="&i).Exist(0) Then
'get the hwnd everytime there's an iteration
ohwnd= Browser("micclass:=Browser", "index:=" & i).GetROProperty("hwnd")
'For debugging purposes
name = Browser("hwnd:="&ohwnd).GetROProperty("title")
msgbox name
Set oBrowser=Browser("hwnd:="&ohwnd)
'Page descriptor
Set oPage=Description.Create
oPage("micclass").Value="Page"
Set oPage=Browser("hwnd:="&ohwnd).ChildObjects(oPage)
For n=0 to oPage.Count-1
If oPage(n).Exist(0) Then
oBrowser.Close
Exit For
End If
Next
End If
Next
If you want to close only a particular page you can use the GETROPREPERTY("Title") in the If loop - If oPage(n).Exist(0)

How to call a visio macro from a stencil

i have written some Macros for Visio. Now I copied these to a Stencil called Macros.vss
How can I call my Macros now?
It all depends on what the macros do and how you'd like to call them. I'm going to assume they're simply macros that will execute something within the active Visio page.
By default in Visio VBA, any public subs with no arguments get added to the Visio Tools->Macros menu, in a folder named by the document holding the macros (in this case Macros) and then separated into folders by module name. If you're the only person using the macros then you probably don't need to do anything else.
However, since you put them in a vss file I'll assume you'd like to distribute them to other people.
There's something funny (and by funny I mean irritating) about Visio and how toolbars and buttons work, when added programmatically. Unfortunately, when you create a toolbar using the UIObject and Toolbar and ToolbarItem classes, Visio is going to assume the code you're calling resides in the active drawing, and cannot be in a stencil. So I can give you a little guidance on using those classes, but basically it consists of distributing a .vst template along with your .vss files, with just a single required sub in the .vst file.
So, instead of using a custom toolbar, you can attach code to shape masters in your .vss file that execute the code when they get dropped on a drawing document (using CALLTHIS and the EventDrop event in the shapesheet). With this method I just have a sub that gets called using callthis that takes a shape object as an argument, executes some code, then deletes the shape (if I don't want it around anymore).
And lastly, you can manipulate the Visio UI programmatically to add a toolbar and buttons for your macros. Below is some sample code, basically the way I do it with a solution I developed. As I mentioned above, the most important part of using this method is to have a document template (.vst) that holds a sub (with the below code it must be named RunStencilMacro) that takes a string as an argument. This string should be the "DocumentName.ModuleName.SubName". This sub must take the DocumentName out of the string, and get a Document object handle to that document. Then it must do ExecuteLine on that document with the ModuleName.SubName portion. You'll have to step through the code and figure some things out, but once you get the hang of what's going on it should make sense.
I'm not sure of any other ways to execute the macros interactively with VBA. I think exe and COM addons may not have this issue with toolbars...
Private Sub ExampleUI()
Dim UI As Visio.UIObject
Dim ToolbarSet As Visio.ToolbarSet
Dim Toolbars As Visio.Toolbars
Dim Toolbar As Visio.Toolbar
Dim ToolbarItems As Visio.ToolbarItems
Dim ToolbarItem As Visio.ToolbarItem
Dim TotalToolBars As Integer
Dim Toolbarpos As Integer
Const ToolbarName = "My Toolbar"
' Get the UIObject object for the toolbars.
If Visio.Application.CustomToolbars Is Nothing Then
If Visio.ActiveDocument.CustomToolbars Is Nothing Then
Set UI = Visio.Application.BuiltInToolbars(0)
Else
Set UI = Visio.ActiveDocument.CustomToolbars
End If
Else
Set UI = Visio.Application.CustomToolbars
End If
Set ToolbarSet = UI.ToolbarSets.ItemAtID(visUIObjSetDrawing)
' Delete toolbar if it exists already
TotalToolBars = ToolbarSet.Toolbars.Count
For i = 1 To TotalToolBars
Set Toolbar = ToolbarSet.Toolbars.Item(i - 1)
If Toolbar.Caption = ToolbarName Then
Toolbar.Visible = False
Toolbar.Delete
Exit For
End If
Next
' create toolbar
Set Toolbar = ToolbarSet.Toolbars.Add
Toolbar.Caption = ToolbarName
Dim IconPos As Long ' counter to determine where to put a button in the toolbar
IconPos = IconPos + 1
Dim IconFunction As String
IconFunction = """Macros.Module1.SubName"""
Set ToolbarItem = Toolbar.ToolbarItems.AddAt(IconPos)
With ToolbarItem
.AddOnName = "RunStencilMacro """ & IconFunction & """"
.Caption = "Button 1"
.CntrlType = Visio.visCtrlTypeBUTTON
.Enabled = True
.state = Visio.visButtonUp
.Style = Visio.visButtonIcon
.Visible = True
.IconFileName ("16x16IconFullFilePath.ico")
End With
' Now establish the position of this toolbar
With Toolbar
.Position = visBarTop 'Top overall docking area
.Left = 0 'Puts it x pixels from the left
.RowIndex = 13
.Protection = visBarNoCustomize
Toolbar.Enabled = True
.Visible = True
End With
Visio.Application.SetCustomToolbars UI
Visio.ActiveDocument.SetCustomToolbars UI
End Sub

Run VBA on any PowerPoint to change the LanguageID

I'm trying to create a toolbar with a button that will change the LanguageID for all shapes and text boxes in a PowerPoint document to EnglishUS. This is to fix a problem where if someone spell-checks a document using another language (in this instance, French), that language is embedded into the .ppt file itself. When another user tries to spell-check the same area using another language, say English, the words the spell checker suggests are in the original language. For instance, it tried to correct the word 'specified' to 'specifie', a French word. From what I've read, the only way to fix this language issue is with a VBscript, and the only way to run a VBscript in Powerpoint without embedding it into a .ppt and loading that file every time is by creating an add-in with a toolbar button to run the macro, also using VBS. Below is the code which I've taken from various sources, and when I tried to put it together, it didn't work (although it did compile). If someone could take a look, I'm sure its a simple syntax error or something like that, it would be a HUGE help. Thanks in advance!!
By the way if anyone knows an easier way to run a macro in PPT without having to open a certain PPT every time, I'm ALL ears.
and now, the script:
Sub Auto_Open()
Dim oToolbar As CommandBar
Dim oButton As CommandBarButton
Dim MyToolbar As String
''# Give the toolbar a name
MyToolbar = "Fix Language"
On Error Resume Next
''# so that it doesn't stop on the next line if the toolbar's already there
''# Create the toolbar; PowerPoint will error if it already exists
Set oToolbar = CommandBars.Add(Name:=MyToolbar, _
Position:=msoBarFloating, Temporary:=True)
If Err.Number <> 0 Then
''# The toolbar's already there, so we have nothing to do
Exit Sub
End If
On Error GoTo ErrorHandler
''# Now add a button to the new toolbar
Set oButton = oToolbar.Controls.Add(Type:=msoControlButton)
''# And set some of the button's properties
With oButton
.DescriptionText = "Fix Language for Spell Check"
''# Tooltip text when mouse if placed over button
.Caption = "Click to Run Script"
''# Text if Text in Icon is chosen
.OnAction = "Button1"
''# Runs the Sub Button1() code when clicked
.Style = msoButtonIcon
''# Button displays as icon, not text or both
.FaceId = 59
End With
''# Repeat the above for as many more buttons as you need to add
''# Be sure to change the .OnAction property at least for each new button
''# You can set the toolbar position and visibility here if you like
''# By default, it'll be visible when created
oToolbar.Top = 150
oToolbar.Left = 150
oToolbar.Visible = True
NormalExit:
Exit Sub ''# so it doesn't go on to run the errorhandler code
ErrorHandler:
''# Just in case there is an error
MsgBox Err.Number & vbCrLf & Err.Description
Resume NormalExit:
End Sub
Sub Button1()
''# This is the code to replace the LanguageID throughout the ppt
Option Explicit
Public Sub ChangeSpellCheckingLanguage()
Dim j As Integer, k As Integer, scount As Integer, fcount As Integer
scount = ActivePresentation.Slides.Count
For j = 1 To scount
fcount = ActivePresentation.Slides(j).Shapes.Count
For k = 1 To fcount
If ActivePresentation.Slides(j).Shapes(k).HasTextFrame Then
ActivePresentation.Slides(j).Shapes(k) _
.TextFrame.TextRange.LanguageID = msoLanguageIDEnglishUS
End If
Next k
Next j
End Sub
End Sub
The answer is quite obvious if it is not clear yet.
As you can see the sub Button1() encapsulates another sub. Thus, I advise you to remove the call ChangeSpellingCheckingLanguage and the last End sub, then your code will work.
This may be an incredibly late answer, but I just solved this problem using VBScript (which can be run outside of powerpoint). The script as written will change the language of each powerpoint file in a given directory (and subdirectories) to English. Here's the script:
Option Explicit
'microsoft office constants
Const msoTrue = -1
Const msoFalse = 0
Const msoLanguageIDEnglishUS = 1033
Const msoGroup = 6
'starting folder (current folder)
Const START_FOLDER = ".\"
'valid powerpoint file extensions
Dim FILE_EXTENSIONS : FILE_EXTENSIONS = Array("pptx", "pptm", "ppt", "potx", "potm", "pot")
'desired language for all Text
Dim DESIRED_LANGUAGE : DESIRED_LANGUAGE = msoLanguageIDEnglishUS
'VBScript file system objects for starting folder
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objStartingFolder : Set objStartingFolder = objFSO.GetFolder(START_FOLDER)
IterateContainingItems objStartingFolder
'recursive subroutine to iterate each file in specified folder and all subfolders
Sub IterateContainingItems(objCurrentFolder)
Dim colFiles : Set colFiles = objCurrentFolder.Files
Dim objCurrentFile
For Each objCurrentFile in colFiles
ReportInfo(objCurrentFile)
Next
Dim colFolders : Set colFolders = objCurrentFolder.SubFolders
Dim objNextFolder
For Each objNextFolder in colFolders
IterateContainingItems objNextFolder
Next
End Sub
'subroutine executed for every file iterated by IterateContainingItems subroutine
Sub ReportInfo(objCurrentFile)
Dim strPathToFile
strPathToFile = objFSO.GetAbsolutePathName(objCurrentFile.Path)
If isPowerpointFile(strPathToFile) Then
Dim objPowerpointApp, objPresentations, objPresentation, objSlides, intSlideCount
set objPowerpointApp = CreateObject("Powerpoint.Application")
set objPresentations = objPowerpointApp.Presentations
Set objPresentation = objPresentations.Open(strPathToFile, msoFalse, msoFalse, msoFalse)
Set objSlides = objPresentation.Slides
intSlideCount = objSlides.Count
ResetLanguage objPresentation
objPresentation.Save
objPresentation.Close
objPowerpointApp.Quit
End If
End Sub
'check if given filepath specifies a powerpoint file as described by the "constant" extension array
Function isPowerpointFile(strFilePath)
Dim strExtension, found, i
strExtension = objFSO.GetExtensionName(strFilePath)
found = false
for i = 0 to ubound(FILE_EXTENSIONS)
if FILE_EXTENSIONS(i) = strExtension then
found = true
exit for
end if
next
isPowerpointFile = found
End Function
'finds every shape in the entire document and attempts to reset its LanguageID
Sub ResetLanguage(objCurrentPresentation)
Dim objShape
'change shapes from presentation-wide masters
If objCurrentPresentation.HasHandoutMaster Then
For Each objShape in objCurrentPresentation.HandoutMaster.Shapes
ChangeLanguage objShape
Next
End If
If objCurrentPresentation.HasNotesMaster Then
For Each objShape in objCurrentPresentation.NotesMaster.Shapes
ChangeLanguage objShape
Next
End If
If objCurrentPresentation.HasTitleMaster = msoTrue Then
For Each objShape in objCurrentPresentation.TitleMaster.Shapes
ChangeLanguage objShape
Next
End If
'change shapes from each design's master
Dim tempDesign
For Each tempDesign in objCurrentPresentation.Designs
For Each objShape in tempDesign.SlideMaster.Shapes
ChangeLanguage objShape
Next
Next
'change shapes from each slide
Dim tempSlide
For Each tempSlide in objCurrentPresentation.Slides
For Each objShape in tempSlide.Shapes
ChangeLanguage objShape
Next
If tempSlide.hasNotesPage Then
For Each objShape in tempSlide.NotesPage.Shapes
ChangeLanguage objShape
Next
End If
Next
End Sub
'if the given shape contains a text element, it checks and corrects the LanguageID
'if the given shape is a group, it iterates through each element in the group
Sub ChangeLanguage(objShape)
If objShape.Type = msoGroup Then
Dim objShapeGroup : Set objShapeGroup = objShape.GroupItems
Dim objShapeChild
For Each objShapeChild in objShapeGroup
ChangeLanguage objShapeChild
Next
Else
If objShape.HasTextFrame Then
Dim intOrigLanguage : intOrigLanguage = objShape.TextFrame.TextRange.LanguageID
If Not intOrigLanguage = DESIRED_LANGUAGE Then
If objShape.TextFrame.TextRange.Length = 0 Then
objShape.TextFrame.TextRange.Text = "[PLACEHOLDER_TEXT_TO_DELETE]"
End If
objShape.TextFrame.TextRange.LanguageID = DESIRED_LANGUAGE
If objShape.TextFrame.TextRange.Text = "[PLACEHOLDER_TEXT_TO_DELETE]" Then
objShape.TextFrame.TextRange.Text = ""
End If
End If
End If
End If
End Sub
To run it, just copy and paste the code into a text editor and save it as "script_name.vbs" in the directory with your powerpoint files. Run it by double clicking the script and waiting.
To load a macro every time PowerPoint is opened, you will want to create a PowerPoint AddIn. Microsoft has provided step-by-step guide for Office XP. For Office 2007 and newer, AFAIK the following steps will do that:
Save file as *.ppam into the directory it suggests (%APPDATA%\Microsoft\AddIns)
Open the Settings (click the office button in the top left corner and select "PowerPoint Options"), select the "Add-Ins" page, choose "PowerPoint Add-Ins" in the drop-down behind "Manage" and click the "Go" button. A dialog opens. Selecting "Add New" brings up a file picker dialog. You should be able to select the file there.
You can also use the Office Custom UI Editor to create ribbons.
However, I have already created such a Language Fixer Add-In for current versions of PowerPoint, and I have put it up for free download for personal use: PowerPoint Language Fixer by Jan Schejbal

Clicking on a link that contains a certain string in VBS

I'm trying to run an automated vbs script that clicks on a link on a page. I have things of the form:
Const READYSTATE_COMPLETE = 4
Set IE = CreateObject("INTERNETEXPLORER.APPLICATION")
IE.Visible = true
IE.navigate ("http://mywebpage.com")
How do I then make it click on a link on that page that doesn't have an ID but is like
ClickMe!
Thanks!
Along the lines of
Dim LinkHref
Dim a
LinkHref = "link"
For Each a In IE.Document.GetElementsByTagName("A")
If LCase(a.GetAttribute("href")) = LCase(LinkHref) Then
a.Click
Exit For ''# to stop after the first hit
End If
Next
Instead of LCase(…) = LCase(…) you could also use StrComp(…, …, vbTextCompare) (see StrComp() on the MSDN).

Resources