웹에서 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
또한 로봇 방법으로 진행하려면 다음과 같이하십시오. 이전주의 사항이 적용됩니다 :
내 답변이 마음에 들지 않아 유감이지만 서비스 약관을 위반하는 데 도움이되는 코드는 게시하지 않을 것입니다. – Tomalak
나는 유효한 대답을 투표해야하는 이유가 없으므로 나는 가벼운 항의로 표결했다. – Fionnuala