Excel VBAでGoogleの検索結果を使用するにはどうすればよいですか？

Question

Googleの検索結果をコピーして、今すぐExcelに貼りたいです。

IEで検索する場所に書き込めましたが、それ以上のことは分かりません。手動検索ページに閲覧以外の手段でGoogleに使用

Sub get() 
With CreateObject("InternetExplorer.application") 
.Visible = True 
.navigate ("http://www.google.com/") 
While .Busy Or .readyState <> 4 
DoEvents 
Wend 
.document.all.q.Value = "keyword" 
.document.all.btnG.Click 
End With 
End Sub 

Answer 1

あなたは、WebからExcelに情報を取得するタスクを達成するさまざまな方法に興味があると思います。特にGoogleではありません。そのような方法の1つが以下に掲載されている。しかし、私は指摘されているように、少なくともTOSに違反するリスクがあります。以下のコードを使用する場合は、すべての潜在的な責任/リスクを自分自身に受け入れることに同意します。提供されるコードは使用するためのものではありませんので、使用する権限を持つサイトでこのタスクを実行する方法を確認することができます。

Option Explicit 

Sub Example() 
    Dim strKeyword As String 
    Dim lngStartAt As Long 
    Dim lngResults As Long 
    Dim ws As Excel.Worksheet 
    On Error GoTo Err_Hnd 
    LockInterface True 
    lngStartAt = 1 
    lngResults = 100 
    strKeyword = "Google TOS" 
    Set ws = Excel.ActiveSheet 
    ws.UsedRange.Delete 
    With ws.QueryTables.Add("URL;http://www.google.com/search?q=" & strKeyword & "&num=100&start=" & lngStartAt & "&start=" & lngResults, ws.Cells(1, 1)) 
     .Name = "search?q=" & strKeyword 
     .WebSelectionType = xlEntirePage 
     .WebFormatting = xlWebFormattingNone 
     .WebPreFormattedTextToColumns = True 
     .WebConsecutiveDelimitersAsOne = True 
     .WebDisableDateRecognition = False 
     .Refresh False 
    End With 
    StripHeader ws 
    StripFooter ws 
    Normalize ws 
    Format ws 
Exit_Proc: 
    On Error Resume Next 
    LockInterface False 
    Exit Sub 
Err_Hnd: 
    MsgBox Err.Description, vbCritical, "Error: " & Err.Number 
    Resume Exit_Proc 
    Resume 
End Sub 

Private Sub StripHeader(ByRef ws As Excel.Worksheet) 
    Dim rngSrch As Excel.Range 
    Dim lngRow As Long 
    Set rngSrch = Intersect(ws.UsedRange, ws.Columns(1)) 
    lngRow = rngSrch.Find("Search Results", ws.Cells(1, 1), xlValues, xlWhole, _ 
     xlByColumns, xlNext, True, SearchFormat:=False).row 
    ws.Rows("1:" & CStr(lngRow + 1&)).Delete 
End Sub 

Private Sub StripFooter(ByRef ws As Excel.Worksheet) 
    Dim lngRowCount As Long 
    lngRowCount = ws.UsedRange.Rows.Count 
    ws.Rows(CStr(lngRowCount - 6&) & ":" & CStr(lngRowCount)).Delete 
End Sub 

Private Sub Normalize(ByRef ws As Excel.Worksheet) 
    Dim lngRowCount As Long 
    Dim lngRow As Long 
    Dim lngLastRow As Long 
    Dim lngDPos As Long 
    Dim strNum As String 
    lngRowCount = ws.UsedRange.Rows.Count 
    ws.Cells(1&, 2&).Value = ws.Cells(3&, 1&).Value 
    lngLastRow = 1& 
    For lngRow = 2& To lngRowCount 
     lngDPos = InStr(ws.Cells(lngRow, 1).Value, ".") 
     If lngDPos Then 
      If IsNumeric(Left$(ws.Cells(lngRow, 1).Value, lngDPos - 1&)) Then 
       ws.Cells(lngRow, 2&).Value = ws.Cells(lngRow + 2&, 1).Value 
       ws.Hyperlinks.Add ws.Cells(lngLastRow, 1&), "http://" & Left$(ws.Cells(lngRow - 2&, 1).Value, InStr(ws.Cells(lngRow - 2&, 1).Value, " ") - 1&) 
       lngLastRow = lngRow 
      End If 
     End If 
    Next 
    ws.Hyperlinks.Add ws.Cells(lngLastRow, 1&), "http://" & Left$(ws.Cells(lngRow - 1&, 1).Value, InStr(ws.Cells(lngRow - 2&, 1).Value, " ") - 1&) 
    For lngRow = lngRowCount To 1& Step -1& 
     If LenB(ws.Cells(lngRow, 2).Value) = 0& Then ws.Rows(lngRow).Delete 
    Next 
End Sub 

Private Sub Format(ByRef ws As Excel.Worksheet) 
    With ws.UsedRange 
     .ColumnWidth = 50 
     .WrapText = True 
     .Rows.AutoFit 
    End With 
    ws.Rows(1).Insert 
    ws.Cells(1, 1).Value = "Result" 
    ws.Cells(1, 2).Value = "Description" 
End Sub 

Public Sub LockInterface(ByVal lockOn As Boolean) 
    Dim blnVal As Boolean 
    Static blnOrgWIT As Boolean 
    With Excel.Application 
     If lockOn Then 
      blnVal = False 
      blnOrgWIT = .ShowWindowsInTaskbar 
      .ShowWindowsInTaskbar = False 
     Else 
      blnVal = True 
      .ShowWindowsInTaskbar = blnOrgWIT 
     End If 
     .DisplayAlerts = blnVal 
     .EnableEvents = blnVal 
     .ScreenUpdating = blnVal 
     .Cursor = IIf(blnVal, xlDefault, xlWait) 
     .EnableCancelKey = IIf(blnVal, xlInterrupt, xlErrorHandler) 
    End With 
End Sub 

さらに、ロボットメソッドに進む場合は、次に進む方法があります。以前の警告が適用されます：

Sub RobotExample() 
    Dim ie As SHDocVw.InternetExplorer 'Requires reference to "Microsoft Internet Controls" 
    Dim strKeyword As String 
    Dim lngStartAt As Long 
    Dim lngResults As Long 
    Dim doc As MSHTML.HTMLDocument  'Requires reference to "Microsoft HTML Object Library" 
    Set ie = New SHDocVw.InternetExplorer 
    lngStartAt = 1 
    lngResults = 100 
    strKeyword = "Google TOS" 
    ie.navigate "http://www.google.com/search?q=" & strKeyword & _ 
     "&num=100&start=" & lngStartAt & "&start=" & lngResults 
    Do Until ie.readyState = READYSTATE_COMPLETE: DoEvents: Loop 
    Set doc = ie.document 
    MsgBox doc.body.innerText 
    ie.Quit 
End Sub 

Answer 2

（現在は）そのTerms of Service（強調鉱山）に反している：

5.3あなたは、アクセス（またはアクセスしようと）しないことに同意任意のサービス Google以外の手段（ ）を使用している場合を除き、具体的に が許可されている場合を除き、Googleとの別契約 で承諾します。 あなたがアクセス（またはアクセスへ の試み）するために特別にないことに同意 サービス のいずれかのあなたはどのに定め 指示に従うことを確認しなければならない（スクリプトやウェブクローラの 使用を含む）任意の自動化手段を通過して robots.txt ファイルがサービスに存在します。

私はこれがあなたの直ぐの問題を解決するものではないことを認識しています。