2009-05-19 4 views
3

Google의 검색 결과를 복사하여 지금 Excel에 붙여 넣고 싶습니다.Excel VBA에서 Google의 검색 결과를 사용하려면 어떻게해야합니까?

IE에서 검색 할 장소에 쓸 수는 있지만 이해할 수는 없습니다. 수동 검색 페이지로 이동하는 것보다 다른 방법으로 구글을 사용

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 
+0

내 답변이 마음에 들지 않아 유감이지만 서비스 약관을 위반하는 데 도움이되는 코드는 게시하지 않을 것입니다. – Tomalak

+0

나는 유효한 대답을 투표해야하는 이유가 없으므로 나는 가벼운 항의로 표결했다. – Fionnuala

답변

3

웹에서 Excel로 정보를 가져 오는 작업을 수행하는 다양한 방법에 관심이 있다고 가정합니다. 특별히 Google은 아닙니다. 그러한 방법 중 하나가 아래에 게시됩니다. 그러나 나는 적어도 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 

또한 로봇 방법으로 진행하려면 다음과 같이하십시오. 이전주의 사항이 적용됩니다 :

4

자신의 Terms of Service (강조 광산)에 대해 (현재)이다

5.3에 액세스하거나 액세스를 시도하지 않는다는 데 동의라도 Google이 제공 한 인터페이스 이외의 방법으로 을 특별히 허용 한 경우가 아니면 Google과의 계약에 의거하여 허용됩니다. 당신은 구체적으로 접근하지 않을 것에 동의합니다 (또는 접근 시도) 및 것은 당신이 어떤에 규정 된 지침을 준수하는지 (스크립트 또는 웹 크롤러의 사용 포함) 자동화 된 수단을 통해 서비스 중 하나를 보장해야한다 robots.txt 파일이 서비스에 있습니다.

나는 이것이 귀하의 즉각적인 문제를 해결하지 못한다는 것을 알고 있습니다.

관련 문제