Bring previous opened window (Word document) to foreground - excel

Suppose I have two hyperlinks (on excel sheet) referring to two documents:
e.g ( A.doc and B.doc ) on my local intranet.
I will open the first document "A.doc" then I will open the second one "B.doc"
The problem:
If there is already an opened word document and then I clicked hyperlink (Word Document on my local intranet),
The later file is not opened automatically and I have to click on the flashing taskbar button to open the cited second file.
This issue occurs only with Microsoft word documents found on my local intranet.
If there is no open document and I clicked on any word hyperlink, It opens normally without any issue.
Please watch this short video to understand my problem.
I need to utilize FollowHyperlink event in excel or any other method to:
bring the previous opened window A.doc to front and then bring the second one B.doc to front.
you may find it a strange question! But I have to do it manually each time to show and bring the second one to front.
I have used this API code (in a Word document) on Normal-ThisDocument:
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Dim LHwnd As Long
Private Sub Document_Open()
If Application.Documents.Count > 1 Then
LHwnd = FindWindow("rctrl_renwnd32", Application.ActiveWindow.Caption)
SetForegroundWindow (LHwnd)
End If
End Sub
And used that code on my excel sheet itself:
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
On Error Resume Next
Dim objWd As Object
Set objWd = GetObject(, "Word.Application")
AppActivate objWd.ActiveWindow.Caption
Set objWd = Nothing
End Sub
Finally, I found this helpful page Bring an external application window to the foreground But I could not adapted it to my need.

Please, try the next BeforeDoubleClick event. If the problem is related only to hyperlinks, it should work...
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.column = 1 And Target.Value <> "" Then 'limit this behavior to the first column
If LCase(left(Target.Value, 5)) = "http:" Then
Cancel = True
Dim objWd As Object, d As Object, arrD: arrD = Split(Target.Value, ".")
If LCase(left(arrD(UBound(arrD)), 3)) <> "doc" Then Exit Sub
On Error Resume Next
Set objWd = GetObject(, "Word.Application") 'find the Word open session, if any
On Error GoTo 0
If objWd Is Nothing Then
Set objWd = CreateObject("Word.Application")
End If
With objWd
.Visible = True
Set d = .Documents.Open(Target.Value)
End With
'force somehow the new open document window expose its handler...
Dim i As Long
Do Until objWd.ActiveWindow.Caption = d.name Or _
objWd.ActiveWindow.Caption = left(d.name, InstRev(d.name, ".")-1) & " [Read-Only] [Compatibility Mode]"
i = i + 1: Debug.Print objWd.ActiveWindow.Caption, left(d.name, InstRev(d.name, ".")-1) & " [Read-Only] [Compatibility Mode]"
DoEvents: If i >= 10 Then Exit Do 'just in case, if something unexpected happens...
Loop
SetForegroundWindow CLngPtr(objWd.ActiveWindow.hWnd)
End If
End If
End Sub
It should work in 64 bit, but it is easy to be adapted for both cases, supposing that it works as you need.

Related

Excel VBA - Get Word doc opened in one of many Word instances

I've searched high and low and the following code is the closest I've come to my objective.
This is what I'm working on:
I wrote some code (OK, honestly, mostly copied bits and pieces and pasted into what is probably jumbled code that works) to email documents to my students. If a doc is open, I get and error, which allows me to manually save and close the doc (thx to Debug), and continue on. I would like to automate this, but Word seems to make things a tad difficult by opening each doc in a separate instance. I can get one instance and its doc, but if it is not the one I need, I cannot save and close it. I found how to get the other instances, but I have not found how to check each instance to see if the doc which it opened is the one I want.
I used ZeroKelvin's UDF in (Check if Word instance is running), which I modified a little bit...
Dim WMG As Object, Proc As Object
Set WMG = GetObject("winmgmts:")
For Each Proc In WMG.InstancesOf("win32_process")
If UCase(Trim(Proc.Name)) = "WINWORD.EXE" Then
*'Beginning of my code...*
*'This is what I need and have no idea how to go about*
Dim WdApp as Word.Application, WdDoc as Object
*' is it better to have WdDoc as Document?*
set WdDoc = ' ### I do not know what goes here ...
If WdDoc.Name = Doc2Send Or WdDoc.Name = Doc2SendFullName Then
*' ### ... or how to properly save and close*
WdApp.Documents(Doc2Send).Close (wdPromptToSaveChanges)
Exit For
End If
*'... end of my code*
Exit For
End If
Next 'Proc
Set WMG = Nothing
Thank you for your time and effort.
Cheers
You may like to consider controlling the number of instances of the Word application that are created. The function below, called from Excel, will return an existing instance of Word or create a new one only if none existed.
Private Function GetWord(ByRef WdApp As Word.Application) As Boolean
' 256
' return True if a new instance of Word was created
Const AppName As String = "Word.Application"
On Error Resume Next
Set WdApp = GetObject(, AppName)
If Err Then
Set WdApp = CreateObject(AppName, "")
End If
WdApp.Visible = True
GetWord = CBool(Err)
Err.Clear
End Function
The function is designed for early binding, meaning you need to add a reference to the Microsoft Word Object Library. During development it's better to work that way. You can change to late binding after your code has been fully developed and tested.
Please take note of the line WdApp.Visible = True. I added it to demonstrate that the object can be modified. A modification done within the If Err bracket would apply only to a newly created instance. Where I placed it it will apply regardless of how WdApp was created.
The next procedure demonstrates how the function might be used in your project. (You can run it as it is.)
Sub Test_GetWord()
' 256
Dim WdApp As Word.Application
Dim NewWord As Boolean
Dim MyDoc As Word.Document
NewWord = GetWord(WdApp)
If NewWord Then
Set MyDoc = WdApp.Documents.Add
MsgBox "A new instance of Word was created and" & vbCr & _
"a document added named " & MyDoc.Name
Else
MsgBox "Word is running and has " & WdApp.Documents.Count & " document open."
End If
End Sub
As you see, the variable WdApp is declared here and passed to the function. The function assigns an object to it and returns information whether that object previously existed or not. I use this info to close the instance if it was created or leave it open if the user had it open before the macro was run.
The two message boxes are for demonstration only. You can use the logical spaces they occupy to do other things. And, yes, I would prefer to assign each document in an instance I'm looking at to an object variable. While using early binding you will get the added benefit of Intellisense.
EDIT
Your procedure enumerates processes. I wasn't able to find a way to determine convert the process into an instance of the application. In other words, you can enumerate the processes and find how many instances of Word are running but I can't convert any of these instances into a particular, functioning instance of the application so as to access the documents open in it. Therefore I decided to enumerate the windows instead and work from there back to the document. The function below specifically omits documents opened invisibly.
Option Explicit
Private Declare PtrSafe Function apiGetClassName Lib "user32" Alias _
"GetClassNameA" (ByVal Hwnd As Long, _
ByVal lpClassname As String, _
ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function apiGetDesktopWindow Lib "user32" Alias _
"GetDesktopWindow" () As Long
Private Declare PtrSafe Function apiGetWindow Lib "user32" Alias _
"GetWindow" (ByVal Hwnd As Long, _
ByVal wCmd As Long) As Long
Private Declare PtrSafe Function apiGetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal Hwnd As Long, ByVal _
nIndex As Long) As Long
Private Declare PtrSafe Function apiGetWindowText Lib "user32" Alias _
"GetWindowTextA" (ByVal Hwnd As Long, ByVal _
lpString As String, ByVal aint As Long) As Long
Private Const mcGWCHILD = 5
Private Const mcGWHWNDNEXT = 2
Private Const mcGWLSTYLE = (-16)
Private Const mcWSVISIBLE = &H10000000
Private Const mconMAXLEN = 255
Sub ListName()
' 256
' adapted from
' https://www.extendoffice.com/documents/excel/4789-excel-vba-list-all-open-applications.html
Dim xStr As String
Dim xStrLen As Long
Dim xHandle As Long
Dim xHandleStr As String
Dim xHandleLen As Long
Dim xHandleStyle As Long
Dim WdDoc As Word.Document
Dim Sp() As String
On Error Resume Next
xHandle = apiGetWindow(apiGetDesktopWindow(), mcGWCHILD)
Do While xHandle <> 0
xStr = String$(mconMAXLEN - 1, 0)
xStrLen = apiGetWindowText(xHandle, xStr, mconMAXLEN)
If xStrLen > 0 Then
xStr = Left$(xStr, xStrLen)
xHandleStyle = apiGetWindowLong(xHandle, mcGWLSTYLE)
If xHandleStyle And mcWSVISIBLE Then
Sp = Split(xStr, "-")
If Trim(Sp(UBound(Sp))) = "Word" Then
ReDim Preserve Sp(UBound(Sp) - 1)
xStr = Trim(Join(Sp, "-"))
Set WdDoc = Word.Application.Documents(xStr)
' this applies if the document was not saved:-
If WdDoc.Name <> xStr Then Set WdDoc = GetObject(xStr)
Debug.Print xStr,
Debug.Print WdDoc.Name
End If
End If
End If
xHandle = apiGetWindow(xHandle, mcGWHWNDNEXT)
Loop
End Sub
Note that it's important to have the API functions at the top of the module - no code above them. Your question doesn't extend to what you want to do with the files but you wanted them listed, and that is accomplished.

How to make an Excel instance visible if there are no open workbooks using VBA

I have several instances of Excel running, maybe up to 4 instances. One of these (let's call in instance A) usually does not have an open workbook. It is used by one of the other instances (let's call it instance B) to open a workbook in instance A, add, change data, then save and close that workbook, thus the instance where these changes are being made (instance A) returns to a state where there are no open workbooks. I do it this way because it is much faster than having the workbook with the code (instance B) open a workbook, perform these tasks and then close the workbook.
My problem is this: From time to time, for debugging purposes mostly, it is desirable to make instance A visible, but what I'm finding is that an instance without an open workbook cannot be made visible, or at least this is what I'm concluding. I am using Excel 2016, 64 bit. My code to do this is:
Private Sub cmdMakeSelectionVisible_Click()
Dim strng As String
Dim lCol As Long, lRow As Long
Dim oXLApp As Excel.Application
Dim bFoundInstance As Boolean
Dim wb_Actress As Workbook
With Me.lstXL '<--| refer to your listbox: change "ListBox1" with your actual listbox name
For lRow = 0 To .ListCount - 1 '<--| loop through listbox rows
If .Selected(lRow) Then '<--| if current row selected
For lCol = 0 To .ColumnCount - 1 '<--| loop through listbox columns
strng = strng & .List(lRow, lCol) & " | " '<--| build your output string
If lCol = 1 Then
MsgBox .List(lRow, lCol)
bFoundInstance = GetReferenceToXLApp(.List(lRow, lCol), oXLApp)
MsgBox oXLApp.Caption
Set wb_Actress = oXLApp.Workbooks.Open("T:\-1996\Dummy Performer's Book.xlsm")
oXLApp.Visible = True
wb_Actress.Close
End If
Next lCol
MsgBox "you selected" & vbCrLf & Left(strng, (Len(strng) - 1)) '<--| show output string (after removing its last character ("|"))
Exit For '<-_| exit loop
End If
Next lRow
End With
End Sub
Inside the For Loops there is an If statement and in that If statement if the instance in question opens a workbook, then the code works. If the instance does not open a workbook and it contains no children, it does not work. If at that point I test to see if oXApp.Visible is true, it is true, but the instance remains hidden.
The question is, is there any way around this without opening a workbook, make the instance visible, then closing the workbook? I still consider myself a novice when it comes to VBA. There may be a totally different approach other than using the handle to the desired instance.
Thanks for looking and helping.
Edit:
The code for GetReferenceToXLApp is:
Public Function GetReferenceToXLApp(hWndXL As Long, oXLApp As Object) As Boolean
Dim hWinDesk As Long
Dim hWin7 As Long
Dim obj As Object
Dim iID As GUID
'// Rather than explaining, go read
'// http://msdn.microsoft.com/en-us/library/windows/desktop/ms687262(v=vs.85).aspx
Call IIDFromString(StrPtr(IID_IDispatch), iID)
'// We have the XL App (Class name XLMAIN)
'// This window has a child called 'XLDESK' (which I presume to mean 'XL desktop')
'// XLDesk is the container for all XL child windows....
hWinDesk = FindWindowEx(hWndXL, 0&, "XLDESK", vbNullString)
'// EXCEL7 is the class name for a Workbook window (and probably others, as well)
'// This is used to check there is actually a workbook open in this instance.
hWin7 = FindWindowEx(hWinDesk, 0&, "EXCEL7", vbNullString)
'// Deep API... read up on it if interested.
'// http://msdn.microsoft.com/en-us/library/windows/desktop/dd317978(v=vs.85).aspx
If AccessibleObjectFromWindow(hWin7, OBJID_NATIVEOM, iID, obj) = RETURN_OK Then
Set oXLApp = obj.Application
GetReferenceToXLApp = True
End If
End Function
And
Private Declare PtrSafe Function IIDFromString Lib "ole32" _
(ByVal lpsz As LongPtr, ByRef lpiid As GUID) As Long
And
Private Declare PtrSafe Function FindWindowEx Lib "User32" Alias "FindWindowExA" _
(ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Seems to work...
Dim oApp As Excel.Application
Sub TT()
Set oApp = New Excel.Application
'oApp.Workbooks.Add
oApp.Visible = True
Debug.Print oApp.HWnd, Application.HWnd
Debug.Print oApp.Caption, Application.Caption
Application.Wait Now + TimeSerial(0, 0, 2)
AppActivate Application.Caption
Application.Wait Now + TimeSerial(0, 0, 2)
AppActivate oApp.Caption
End Sub

Method 'Text' of object 'ISapCTextField' failed

I have to pull data from SAP. This error happens randomly:
Method 'Text' of object 'ISapCTextField' failed
I searched but none of the solutions work. Error handling by trying multiple times also didn't work. Instead of trying more methods, I avoided the .Text method altogether.
Example of line causing the error:
session.findById("wnd[0]/usr/ctxtMATNR-LOW").text = "500000000"
To avoid using the .text method, I used SendKeys to achieve the same thing. Basically making the SAP window as active window and selecting the desired field in SAP GUI by using set focus, and then using Ctrl+V via sendkeys to paste the text from a range to the field. Below is the code:
'Declaration
Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Declare Function SetForegroundWindow Lib "user32" ( _
ByVal HWnd As Long) As Long
'Finds SAP Window.
Public Sub ActivateSAPWindow()
Dim HWnd As Long
'SAP window Name can be found on the status bar of the Portal.
'Note: This only works in when you click on R/3 and it open a portal. It will not work if it open in the internet explorer
'To make it work for internet explorer , Simply change the name of the Window to find internet explorer or any window you wish.
HWnd = FindWindow(vbNullString, "R/3 - SAP NetWeaver Portal - Internet Explorer")
If HWnd Then
SetForegroundWindow HWnd
End If
End Sub
Public Sub SAPSafeText(ID As String, OriginCell As String)
'Location of the cell you wanna copy to the field.
Worksheets("SAP Mapping").Range(OriginCell).Copy
Call ActivateSAPWindow
Session.FindByID(ID).SetFocus
SendKeys "^v"
'Important to wait for completion before next line.
Wait (5)
End Sub
To call the function , Simply use SAP script record to get the Field ID name and parse into the SAPSafeText("ID of the Field as string", "Cell Range as string").
Example of call:
Call SAPSafeText("wnd[0]/usr/ctxtBWART-LOW", Low)
Call SAPSafeText("wnd[0]/usr/ctxtBWART-HIGH", High)
This is the brute force way but it works.
Why is the error happening?
Is there a better way to handle this?
I met the same situation too. I solve it. I think that is you use the sentence like
session.findbyid (*****).text = cells(i,j)
you should try to use
session.findbyid (*****).text = cells(i,j).value
You could try the following instead of sendkeys method:
...
Application.Wait (Now + TimeValue("0:00:01"))
session.findById("wnd[0]/usr/ctxtMATNR-LOW").text = "500000000"
...
Regards,
ScriptMan
below are snips of the code that could cause the random error. There are about 7 other Reports. Here is the MRP report example.
Public SapGuiAuto As Object
Public SAPApp As SAPFEWSELib.GuiApplication
Public SAPConnection As SAPFEWSELib.GuiConnection
Public Session As SAPFEWSELib.GuiSession
Sub InitSession()
On Error GoTo InternetAutomation
ErrorCounter = ErrorCounter + 1
Set SapGuiAuto = GetObject("SAPGUI")
If Not IsObject(SapGuiAuto) Then
Exit Sub
End If
Set SAPApp = SapGuiAuto.GetScriptingEngine()
If Not IsObject(SAPApp) Then
Exit Sub
End If
Set SAPConnection = SAPApp.Connections(0)
If Not IsObject(SAPConnection) Then
Exit Sub
End If
Set Session = SAPConnection.Sessions(0)
If Not IsObject(Session) Then
Exit Sub
End If
Exit Sub
InternetAutomation:
.........
End sub
sub MRP()
Call InitSession
Call TCodeBox("/n/DS1/APO_C_")
Call PlantCode_MRP("A11")
Call Material_MRP("E3")
Call SetPath_MRP
Call Execute
Call MRPReportProcess
End Sub
Sub PlantCode_MRP(Cell As String)
session.findById("wnd[0]/usr/ctxtS_WERKS-LOW").Text = Range(Cell)
session.findById("wnd[0]/usr/btn%_S_WERKS_%_APP_%-VALU_PUSH").press
Call SAPMultiSelect(Cell)
End Sub
Sub Material_MRP(Cell As String)
Worksheets("MB52 Total").Activate
session.findById("wnd[0]/usr/btn%_S_MATNR_%_APP_%-VALU_PUSH").press
Call SAPMultiSelect(Cell)
End Sub
Sub SetPath_MRP()
session.findById("wnd[0]/usr/ctxtP_PATH").Text = Desktop
session.findById("wnd[0]/usr/txtP_NAME").Text = MRPFileName
End Sub
Sub TCodeBox(TCode As String)
session.findById("wnd[0]/tbar[0]/okcd").Text = TCode
On Error GoTo TCodeErrorHandler
session.findById("wnd[0]").sendVKey 0
TCodeErrorHandler:
session.findById("wnd[0]/tbar[0]/btn[15]").press
session.findById("wnd[0]/tbar[0]/okcd").Text = TCode
session.findById("wnd[0]").sendVKey 0
Resume Next
Exit Sub 'Enter
End Sub
Sub Execute()
session.findById("wnd[0]/tbar[1]/btn[8]").press
End Sub
Regards,Jacob.
Sometimes I could solve similar errors by restarting the transaction.
for example:
Sub PlantCode_MRP(Cell As String)
on error resume next
session.findById("wnd[0]/usr/ctxtS_WERKS-LOW").Text = Range(Cell)
if err.number <> 0 then
Call TCodeBox("/n/DS1/APO_C_")
session.findById("wnd[0]/usr/ctxtS_WERKS-LOW").Text = Range(Cell)
end if
on error goto 0
'On Error GoTo InternetAutomation
session.findById("wnd[0]/usr/btn%_S_WERKS_%_APP_%-VALU_PUSH").press
Call SAPMultiSelect(Cell)
End Sub
Regards,
ScriptMan

Open Word Document and Bring to Front

Below is a working code snippet that opens a Microsoft Word document, and goes to a specific index from the Table of Contents. filePath is a filepath, and strTopic is a value that links to the Table of Contents in the Word document.
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set docWord = objWord.Documents.Open(fileName:=strPath, ReadOnly:=True)
docWord.Bookmarks(strTopic).Range.Select
I need to bring the Word document to the foreground.
Is there a toFront() type "function" in VBA?
You can achieve what you want using APIS. I am using two APIs SetForegroundWindow and FindWindow
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) _
As Long
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) _
As Long
Sub Sample()
Dim objWord As Object, docWord As Object
Dim strPath As String, FileName As String
Dim hwnd As Long
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
'~~> Change this to the relevant Filename and path
strPath = "C:\Users\Siddharth Rout\Desktop\Sample.docx"
'~~> Put the acutal file name here without the extension
FileName = "Sample"
Set docWord = objWord.Documents.Open(FileName:=strPath, ReadOnly:=True)
hwnd = FindWindow(vbNullString, FileName & " [Read-Only] - Microsoft Word")
If hwnd > 0 Then
SetForegroundWindow (hwnd)
End If
End Sub
NOTE: If you are sure that there is no other Word Application open other than what you opened then you can use this as well :)
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Sub Sample()
Dim objWord As Object, docWord As Object
Dim strPath As String
Dim hwnd As Long
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
'~~> Change this to the relevant Filename and path
strPath = "C:\Users\Siddharth Rout\Desktop\Sample.docx"
Set docWord = objWord.Documents.Open(FileName:=strPath, ReadOnly:=True)
hwnd = FindWindow("OpusApp", vbNullString)
If hwnd > 0 Then
SetForegroundWindow (hwnd)
End If
End Sub
How about,
docWord.Activate
This should bring the file that has been "Set" for the docWord object to foreground.
EDIT: Tested this on Access, quiet unreliable on Excel. Using an API is the best way to go if there are multiple instances of the Word application running.
Once you've opened a document (or added one) you can get a Hwnd to pass to the SetForegroundWindow API function from the ActiveWindow object (e.g. obWord.ActivieWindow.Hwnd). That way you don't need to search for the correct Word instance to bring to front.
This seems to work every time. Word running or not, multiple docs open or not.
OpenAlready:
On Error GoTo 0
With wrdApp
.Selection.Goto What:=1, Which:=2, Name:=PageNumber
.Visible = True
.Activate '<---seems to work well. regardless of number of Word docs open OR not open.
End With
Set wrdDoc = Nothing
Set wrdApp = Nothing
i'm quite new here, and in doing a ~30 min research on this specific case, I think I could bring something to the table here...
I found in this link: http://www.vbaexpress.com/forum/showthread.php?27589-bringing-Word-in-fornt-of-Excel this line of code:
Application.ActivateMicrosoftApp xlMicrosoftWord
It will force Word in front of everything, BUT if there is something opened it will create a new document, so what I found is that, if you want to open something and then bring it to front you use this sintax:
[...]
Application.ActivateMicrosoftApp xlMicrosoftWord
Word.Documents.Open(MyDocument)
[...]
Once in vba debugging the code will always be in front, but when using the code with the excel vba userform it works great! I can see the word changing the words on the fly!!!!
Can also use AppActivate "Microsoft Word"
visit Microsoft help :here
Using AppActivate needs the exact title of the window you want focused. E.g. for a word 2013 template opened as an "add", you would have to use AppActivate "Document1 - Word"
I just use;
FileAndPath = "C:\temp\Mydocument.docx"
ThisWorkbook.FollowHyperlink (FileAndPath)
It even works if the file is already open.
Since ".Activate" is comented various times but at least for me calling it from excel to bring to fornt a word doc.
I have to do a work around minimizing and maximazing the window.
This works well for me until now:
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True
wdApp.ScreenUpdating = True
Set wdDoc = wdApp.Documents.Open(ThisWorkbook.Path & "\" & stWordDocument) 'update your path
wdDoc.Activate
ActiveDocument.ActiveWindow _
.WindowState = wdWindowStateMinimize
ActiveDocument.ActiveWindow _
.WindowState = wdWindowStateMaximize
found!
ActiveDocument.Activate 'might not be necessary
ActiveDocument.Windows.Application.WindowState = wdWindowStateMaximize
works flawlessly. I already had an "activedocument" I was working on.
http://www.access-programmers.co.uk/forums/showthread.php?t=173871

Get text from clipboard using GetText - avoid error on empty clipboard

I'm using code like this to get text from off the Clipboard.
Dim DataObj As New MSForms.DataObject
DataObj.GetFromClipboard
myString = DataObj.GetText
I use error handling to get the past the case where the Clipboard is empty, and everything is fine as long as I keep Error Trapping set to Break on Unhandled Errors.
However, for unrelated reasons I want to set Error Trapping to Break on All Errors, and this throws an error at DataObj.GetText when it finds the empty Clipboard. Is there any kind of test I can apply further upstream to avoid trying to process an empty Clipboard?
Handle the errors with On Error GoTo as shown here:
Sub GetClipBoardText()
Dim DataObj As MSForms.DataObject
Set DataObj = New MsForms.DataObject '<~~ Amended as per jp's suggestion
On Error GoTo Whoa
'~~> Get data from the clipboard.
DataObj.GetFromClipboard
'~~> Get clipboard contents
myString = DataObj.GetText(1)
MsgBox myString
Exit Sub
Whoa:
If Err <> 0 Then MsgBox "Data on clipboard is not text or is empty"
End Sub
You will notice that it will handle an empty clipboard as well.
NB: to make the code work, you must have a reference to "Microsoft Forms 2.0 Object Library" (this file can be found at C:\windows\system32\FM20.dll on 32-bit machines, or at C:\Windows\sysWOW64\FM20.dll on 64-bit machines), otherwise you'd get the error "User-Defined type not defined".
You can empty the clipboard before testing the above code by using the code below. Please paste it in a module.
Private Declare Function OpenClipboard Lib "User32.dll" _
(ByVal hWndNewOwner As Long) As Long
Private Declare Function EmptyClipboard Lib "User32.dll" () As Long
Private Declare Function CloseClipboard Lib "User32.dll" () As Long
Public Sub ClearClipboard()
Dim Ret
Ret = OpenClipboard(0&)
If Ret <> 0 Then Ret = EmptyClipboard
CloseClipboard
End Sub
EDIT: you may also determine if the clipboard is empty by using this code:
Private Declare Function CountClipboardFormats Lib "user32" () As Long
Sub Sample()
If (CountClipboardFormats() = 0) = True Then
MsgBox "Clipboard is empty"
Else
MsgBox "Clipboard is not empty"
End If
End Sub
add the follwoing code just b4 the breaking line for debuging.... the error disapeared for me after that test.. wierd but it somehow works (Excel 2010)
myString = DataObj.GetText(1)
MsgBox myString

Resources