MW211 EXIT

devlog
ExcelVBA/翻訳
2015年08月11日
Google翻訳を利用した英和・和英の一括翻訳マクロ。
セル選択(複数可)して実行すると、右隣に翻訳結果が出力される。
┌──────────────────────────────────────┐
│Public Sub Google翻訳英和()                                                 │
│    Dim i As Long                                                           │
│    Dim theCell As Range                                                    │
│    Dim objIE As Object                                                     │
│    For Each theCell In Selection                                           │
│        If theCell.Value <> "" Then                                         │
│            Application.Wait Now + TimeValue("00:00:01")  ' スリープ約1秒   │
│            Set objIE = CreateObject("InternetExplorer.Application")        │
│            With objIE                                                      │
│                .Navigate "https://translate.google.co.jp/#en/ja/" _        │
│                        & theCell.Value                                     │
│                Do While .Busy Or .ReadyState <> 4                          │
│                    DoEvents                                                │
│                Loop                                                        │
│                With .Document.getElementById("result_box")                 │
│                    For i = 1 To 10000  ' リトライ                          │
│                        If .innerText <> "" Then                            │
│                            Exit For                                        │
│                        End If                                              │
│                        DoEvents                                            │
│                    Next i                                                  │
│                    theCell.Offset(, 1).Value = .innerText                  │
│                End With                                                    │
│                .Quit                                                       │
│            End With                                                        │
│        End If                                                              │
│    Next theCell                                                            │
│    MsgBox "完了"                                                           │
│End Sub                                                                     │
├──────────────────────────────────────┤
│Public Sub Google翻訳和英()                                                 │
│    Dim i As Long                                                           │
│    Dim theCell As Range                                                    │
│    Dim objIE As Object                                                     │
│    For Each theCell In Selection                                           │
│        If theCell.Value <> "" Then                                         │
│            Application.Wait Now + TimeValue("00:00:01")  ' スリープ約1秒   │
│            Set objIE = CreateObject("InternetExplorer.Application")        │
│            With objIE                                                      │
│                .Navigate "https://translate.google.co.jp/#ja/en/" _        │
│                        & theCell.Value                                     │
│                Do While .Busy Or .ReadyState <> 4                          │
│                    DoEvents                                                │
│                Loop                                                        │
│                With .Document.getElementById("result_box")                 │
│                    For i = 1 To 10000  ' リトライ                          │
│                        If .innerText <> "" Then                            │
│                            Exit For                                        │
│                        End If                                              │
│                        DoEvents                                            │
│                    Next i                                                  │
│                    theCell.Offset(, 1).Value = .innerText                  │
│                End With                                                    │
│                .Quit                                                       │
│            End With                                                        │
│        End If                                                              │
│    Next theCell                                                            │
│    MsgBox "完了"                                                           │
│End Sub                                                                     │
└──────────────────────────────────────┘
「.Busy Or .ReadyState <> 4」の条件でIEの読込完了を待つのだが、
ID指定で要素を読み込むためにはさらに若干タイムラグがある模様。

それが未だだと空欄取得となってしまうので、リトライを用意した。

なお、クローラみたいなものなので1秒間をあけて実行するようにした。
分類:ExcelVBA