fork download
copy 
  1. Sub type_key_emu()
  2. Dim Wdapp As Object
  3. Dim task As Object
  4. Dim Flag As Integer
  5. Dim i As Long
  6. Dim url As String
  7. Dim buf As Variant
  8.  
  9. 'direct3.jp-bank.japanpost.jp/tp1web/pc/U730201SCK.do
  10. '以下の""で囲まれたURLの内容は頭部の「https://」を除くと正確には上記のとおり
  11.  
  12. url = "https://d...content-available-to-author-only...t.jp/tp1web/pc/U730201SCK.do"   '実際に会員番号を入力するサイトのURLに変更する
  13. Set Wdapp = CreateObject("Word.Application")
  14. Dim WSH As Object
  15. Set WSH = CreateObject("WScript.Shell")
  16. retry:
  17. Call start_browser(url)
  18. Application.Wait [Now()] + 10000 / 86400000  '10000でミリ秒単位の待ち時間を指定。環境に併せて数値を調整する。
  19. Flag = 0
  20. For Each task In Wdapp.Tasks
  21.     If task.Visible = True And InStr(task.Name, " Edge") > 0 Then
  22.         Flag = 1
  23.         WSH.Popup "そのまましばらくお待ちください", 5, "Title", vbInformation
  24.         task.Activate
  25.         For i = 1 To 1  '最初の入力ボックスにコントロールを移すためのTABキーの送出回数を指定(ここでは1回)
  26.             Call SendKeys("{TAB}")
  27.         Next
  28.     End If
  29. Next
  30. If Flag = 0 Then
  31.     WSH.Popup "Microsoft Edgeは起動していません", 5, "Title", vbInformation
  32.     GoTo retry
  33.     Exit Sub
  34. End If
  35. Wdapp.Quit
  36. Set Wdapp = Nothing
  37. Set WSH = Nothing
  38.  
  39. For i = 2 To 4
  40.     Application.Wait [Now()] + 600 / 86400000  '各ボックスに入力後の待ち時間を指定(短すぎると、正しく送出されない)    
  41.     buf = Cells(3, i).Text
  42.     Call SetCB(buf)
  43.     Call SendKeys("^V")
  44. Next
  45. End Sub
  46. Sub SendKeys(Keys As String, Optional Wait As Boolean = False)
  47.     Static w As Object
  48.     If w Is Nothing Then
  49.         Set w = CreateObject("WScript.Shell")
  50.     End If
  51.     Call w.SendKeys(Keys, Wait)
  52. End Sub
  53. Sub SetCB(ByVal strSet As String)
  54.     With CreateObject("Forms.TextBox.1")
  55.         .MultiLine = True
  56.         .Text = strSet
  57.         .selstart = 0
  58.         .sellength = .textlength
  59.         .Copy
  60.     End With
  61. End Sub
  62. Sub start_browser(url As String)
  63.     With CreateObject("Wscript.Shell")
  64.         .Run url
  65.     End With
  66. End Sub
  67.  
Not running #stdin #stdout 0s 0KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
https://ideone.com/dIl7bl
language:
Text (text 6.10)
created:
303 days ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!