既存IEのテキストボックスにEXCELの値を貼り付ける動作が不安定 削除
Message#1 2015年4月15日(水)13時39分 From: 鈴木 |
Excelのテキストをクリップボードに送信し、既に開いているIEのテキストボックスに貼り付けようとしています。 テスト用にhttps://www.google.co.jp/?gws_rd=sslを開いて下記を実行すると →部分で中断する場合と貼り付けまでできる場合があります。 但し、現在は手動で、IEを最上画面にし貼り付け許可をクリックしています。 NGの場合は mystr=””になります。 何か対処方法はありますか? Public objIE As InternetExplorer #If VBA7 Then Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr) #Else Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As Long) #End If 'ダブルクリックでスタートする Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim objInpTxt As HTMLInputTextElement Dim mystr As String Dim objSh As Object Dim objWin As Object Dim winex As Boolean Dim cURL As String Call CBSetText(Target.Value) Cancel = True winex = False Set objSh = CreateObject("Shell.Application") For Each objWin In objSh.Windows If TypeName(objWin.document) = "HTMLDocument" Then winex = True Set objIE = objWin cURL = objIE.document.URL End If Next Set objSh = Nothing objIE.navigate ("about:blank") → mystr = objIE.document.parentWindow.clipboardData.GetData("text") objIE.navigate cURL Call IEWait(objIE) Set objInpTxt = objIE.document.getElementsByName("q")(0) objInpTxt.Value = mystr End Sub Function IEWait(ByRef objIE As Object) Do While objIE.Busy = True Or objIE.readyState <> 4 DoEvents Loop End Function 'クリップボードにコピーする Sub CBSetText(strValue As String) With New MSForms.DataObject .SetText strValue .PutInClipboard End With End Sub |
上のメッセージを削除します。
よければパスワードを入力し、削除ボタンをクリックしてください。