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
Related
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.
I am trying to have a user file selection box automatically open up to a directory.
Everything works fine, but instead of opening to the correct directory, I still have to click through to the right one.
My code is as follows.
ChDir ("\\file path string")
userFile = Application.GetOpenFilename(fileFilter:="csv Files(*.csv),*.csv", Title:="csv Files")
Workbooks.OpenText Filename:=userFile
I have also been able to get anything like ChDrive to work. The file is on a network.
Thank you
I use this when I need to set the current directory to a network share:
Option Explicit
Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long
Sub ChDirNet(szPath As String)
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
End Sub
Sub tester()
ChDirNet "\\marge\bart\"
End Sub
There is a missing keyword, "PtrSafe" in the sample code for it to work on 64-bit versions of Office. The code should look like this
Option Explicit
Private Declare PtrSafe Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long
Sub ChDirNet(szPath As String)
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
End Sub
Sub tester()
ChDirNet "\\marge\bart\"
End Sub
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.
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
I am using Excel VBA to copy text selection from an Access file (I'd prefer not to get into details as to why). I have it in a Do While loop that SHOULD press the tab key (works), then copies the data (fails), puts it into the clipboard (works), and sets the clipboard information to a variable (works), which then, for debugging purposes, does a debug.print of the variable (works). This is to cycle through a form to get to a "base point" where I can 100% use tabs and such to navigate to other parts of the form. See code please:
AppActivate ("Microsoft Access - Filename that is constant")
X = 0
Do While X < 14
Application.SendKeys "{TAB}", True
Application.SendKeys "^C", True
Sleep (500)
mydata.GetFromClipboard
cb = mydata.GetText
Debug.Print (cb)
If Len(cb) = 5 Then
X = 14
End If
X = X + 1
Loop
Set mydata = Nothing
I've tried getting this to work, but to no avail. What am I doing wrong or perhaps what would be a better solution?
Though I hate Sendkeys and was wondering whether I should ask you about it but since you said not to ask why, I will keep my trap shut. :P
Try this small fix... If this works then that means, you need to give it some time before issuing the next sendkeys command.
Sub Sample()
'
'~~> Rest of your code
'
Application.SendKeys "{TAB}", True
Wait 2
Application.SendKeys "^{C}", True
'
'~~> Rest of your code
'
End Sub
Private Sub Wait(ByVal nSec As Long)
nSec = nSec + Timer
While nSec > Timer
DoEvents
Wend
End Sub
what would be a better solution?
Use APIs as shown Here. This doesn't directly answer your question but it explains how the concept works.
So applying that would be something like this
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Dim Ret As Long
Sub Sample()
Ret = FindWindow(vbNullString, "Microsoft Access - Filename that is constant")
If Ret <> 0 Then
MsgBox "Window Found"
Else
MsgBox "Window Not Found"
End If
End Sub
If you wish to become good at API’s like FindWindow, FindWindowEx and SendMessage then get a tool that gives you a graphical view of the system’s processes, threads, windows, and window messages. For Ex: uuSpy or Spy++. Another example which demonstrates how this API is used.
I figured it out. I copied the code from here: http://www.vbaexpress.com/forum/showthread.php?38826-SendInput()-in-Excel-64Bit
I changed VkkeyMenu to VbKeyControl and the "f" key to "C". I know it could be simplified to take up less lines, but I'd rather not mess with it if it works like the saying "If it ain't broke, don't fix it." Code:
Private Declare PtrSafe Function SendInput Lib "user32" (ByVal nInputs As LongPtr, pInputs As Any, ByVal cbSize As LongPtr) As LongPtr
Private Declare PtrSafe Function VkKeyScan Lib "user32" Alias "VkKeyScanA" (ByVal cChar As Byte) As Integer
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Type KeyboardInput ' creating variable type
dwType As Long ' input type (keyboard or mouse)
wVk As Integer ' the key to press/release as ASCSI scan code
wScan As Integer ' not required
dwFlags As Long ' specify if key is pressed or released
dwTime As Long ' not required
dwExtraInfo As Long ' not required
dwPadding As Currency ' only required for mouse inputs
End Type
' SendInput constants
Private Const INPUT_KEYBOARD As Long = 1
Private Const KEYEVENTF_EXTENDEDKEY As Long = 1
Private Const KEYEVENTF_KEYUP As Long = 2
' Member variables
Private TheKeys() As KeyboardInput
Private NEvents As Long
Sub testage()
ReDim TheKeys(0 To 3)
With TheKeys(0)
.dwType = INPUT_KEYBOARD 'operation type
.wVk = vbKeyControl 'press CTRL key
End With
With TheKeys(1)
.dwType = INPUT_KEYBOARD ' operation
.wVk = VkKeyScan(Asc("C")) 'press chr key
End With
With TheKeys(2)
.dwType = INPUT_KEYBOARD 'operation type
.wVk = VkKeyScan(Asc("C"))
.dwFlags = KEYEVENTF_KEYUP 'release chr key
End With
With TheKeys(3)
.dwType = INPUT_KEYBOARD ' operation type
.wVk = vbKeyControl
.dwFlags = KEYEVENTF_KEYUP 'release CTRL Key
End With
Call SendInput(4, TheKeys(0), Len(TheKeys(0)))
Erase TheKeys
End Sub