如何在MicrosoftWord檔案中快速搜索Google上的選定文本？

我發現了一篇帶有宏的文章，可以在 Microsoft Word 檔案中選擇文本并在 Google 上搜索： https ://www.datanumen.com/blogs/quickly-search-selected-text-google-yahoo-bing-word-檔案/

但是，第一行的代碼“Dim objIE As Object”使它無法在我的計算機上運行，??因為我的公司多年前已經卸載了 Internet Explorer (IE)。而當前的 Microsoft Edge API 不允許這種方法。

Sub OpenBrowser(strAddress As String, Menubar As Boolean, nHeight As Long, nWidth As Long, varResizable As Boolean)
  Dim objIE As Object
 
  '  Create and set the object settings.
  Set objIE = CreateObject("InternetExplorer.Application")
 
  With objIE
    .Visible = False
    .width = nWidth
    .height = nHeight
    .Menubar = Menubar
    .Visible = True
    .resizable = varResizable
    .Navigate strAddress
  End With

End Sub

Sub SearchOnGoogle()
  Dim strText As String
  Dim strButtonValue As String
 
  strButtonValue = MsgBox("Do you want to search the selected text on Google?", vbYesNo, "Search on Google")
    If strButtonValue = vbNo Then
      Exit Sub
    Else
      '  Make sure there is text selected.
      If Selection.Type <> wdSelectionIP Then
        strText = Selection.text
        strText = Trim(strText)
      Else
        MsgBox ("Please select text first!")
        Exit Sub
      End If
 
      '  Search selected text on Google with browser window opened in set size.
      OpenBrowser "https://www.google.com/search?num=20&hl=en&q=" & strText, True, 550, 650, True
    End If
End Sub

然后，我撰寫了以下宏來選擇 MS Word 中的單詞，然后在 Google 上搜索。但它只能搜索一個單詞。如果選擇多個單詞（如“社會資本”）并運行此宏，Chrome 會彈出兩次，分別搜索“社會”和“資本”。

Sub Google_Search_Single_Word()

Dim theTerm As String
Dim strURL As String
Dim arrSites(1)
Dim appPath As String
Dim strText As String
Dim strButtonValue As String
  
appPath = """C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"""

If Selection.Type = wdSelectionIP Then
theTerm = Selection.Words(1).Text
Else
theTerm = Selection.Text

End If

arrSites(1) = "http://www.google.com/search?hl=en&q="   theTerm

For i = 0 To 1 Step 1
strURL = arrSites(i)

Shell (appPath & " -url " & strURL)

Next i
End Sub

因此，我從網站上找到了 Excel VBA 宏的一個版本：https ://excelchamps.com/blog/vba-code-search-google-chrome/ ，它也適用于 MS Word。但是，這是一種彈出框進行搜索的方法。如果您沒有在上面輸入任何內容，它仍然會自動打開谷歌瀏覽器，這不是用戶友好的。

Sub GoogleSearch()

Dim chromePath As String
Dim search_string As String
Dim query As String

query = InputBox("Please enter the keywords", "Google Search")
search_string = query
search_string = Replace(search_string, " ", " ")

chromePath = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"

Shell (chromePath & " -url http://www.google.com/search?hl=en&q=" & search_string)

End Sub

我很感謝我能享受到不同專家的上述貢獻。有誰知道如何編輯上述版本之一以制作可以在 Microsoft Word 檔案中快速搜索 Google 上選定文本的宏？

uj5u.com熱心網友回復：

這是Google_Search_Single_Word可以處理多個單詞的 Sub 版本。它使用輔助函式 URLEncode，您需要在專案中包含 Microsoft ActiveX 資料物件庫（工具 > 參考。如果有多個版本可用，請使用最高版本號）。

URLEncode 來自這個答案。

Sub Google_Search_Selected_Text()

Dim theTerm As String
Dim strURL As String
Dim arrSites(1)
Dim appPath As String
Dim strText As String
Dim strButtonValue As String
  
appPath = """C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"""

theTerm = URLEncode(Selection.Text)
MsgBox theTerm

arrSites(1) = "http://www.google.com/search?hl=en&q="   theTerm

For i = 0 To 1 Step 1
strURL = arrSites(i)

Shell (appPath & " -url " & strURL)

Next i
End Sub


Public Function URLEncode( _
   ByVal StringVal As String, _
   Optional SpaceAsPlus As Boolean = False _
) As String
  Dim bytes() As Byte, b As Byte, i As Integer, space As String

  If SpaceAsPlus Then space = " " Else space = "%20"

  If Len(StringVal) > 0 Then
    With New ADODB.Stream
      .Mode = adModeReadWrite
      .Type = adTypeText
      .Charset = "UTF-8"
      .Open
      .WriteText StringVal
      .Position = 0
      .Type = adTypeBinary
      .Position = 3 ' skip BOM
      bytes = .Read
    End With

    ReDim Result(UBound(bytes)) As String

    For i = UBound(bytes) To 0 Step -1
      b = bytes(i)
      Select Case b
        Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
          Result(i) = Chr(b)
        Case 32
          Result(i) = space
        Case 0 To 15
          Result(i) = "%0" & Hex(b)
        Case Else
          Result(i) = "%" & Hex(b)
      End Select
    Next i

    URLEncode = Join(Result, "")
  End If
End Function

轉到 Google，輸入兩個單詞（例如dog food），然后查看生成的 URL。dog請注意，和之間的空格food已替換為 符號 ( https://www.google.com/search?q=dog food)。這稱為 URL 轉義，是正確解釋 URL 所必需的。Sub 的原始版本沒有轉義 URL，因此 Google 只選擇了第一個單詞。

我發布的版本對 URL 進行了轉義，以確保將空格轉換為 ，以及處理其他需要轉義的字符，例如!-> !、?->?等。

標籤：vbams-word

上一篇：如何根據某些條件附加到excel中的串列？

下一篇：根據多列中的字串條件洗掉行