Hi there,
Here is the VBScript you are looking for:
Save the script as test.vbs and do the following
1) Once you double click the vbs file, a file open dialog will come up
and it will ask you to select the excel sheet that contains the search
keywords. Select the file.
2) Then in the next two input boxes provide the starting row and
column no. where the words are stored in the excel sheet
3) THe script will check whether selected file is already opened or not.
4) The results will be stored in the next column.
Please revert back in case of any issues.
the script goes here.....
===============================================
TEST.VBS
===============================================
Call FindLinks()
msgbox "SUCCESS"
Sub FindLinks()
On Error Resume Next
Dim objExcel
Dim book
Dim strLink
Dim strFilter
Const CLOSED_OR_CANCELLED = 0
Dim intGetRow
Dim intGetColumn
Dim intCounter
Dim strFile
intColumn=1
set objExcel = wscript.CreateObject("Excel.Application")
'loop until user selects a .xls file.
Do
'File filters
strFilter = "All Microsoft Excel Files (*.xl; *.xls; *.xlt; *.htm;
*.html),*.xl; *.xls; *.xlt; *.htm; *.html"
'get the Excel file name
strFile = objExcel.GetOpenFilename(strFilter,1)
If strFile = CLOSED_OR_CANCELLED Then
msgbox "CANCELLED"
Call WScript.Quit(1)
End If
If err.Number <> 0 Then
msgbox err.number & err.Description
WScript.Quit(1)
End If
Loop While strFile = ""
Do
If IsFileOpen(strFile) Then
msgbox "The excel sheet you selected is already opened. Please
close it to proceed."
End If
Loop While IsFileOpen(strFile)
objExcel.Workbooks.Open(strFile)
objExcel.Visible = True
intGetRow = CInt(InputBox("Please enter the row number from where
the search words are starting in the selected excel sheet", "tiwari
dot vikas at gmail dot com",1))
intGetColumn = CInt(InputBox("Please enter the column number where
the search words are stored in the selected excel sheet", "tiwari dot
vikas at gmail dot com",1))
For intCounter = intGetRow to 1000
If objExcel.Cells(intCounter,intGetColumn) <> "" Then
strLink = GetGoogleLink(objExcel.Cells(intCounter,intGetColumn))
objExcel.Cells(intCounter,intGetColumn+1) = strLink
'Exit For
Else
Exit For
End If
Next
'save the sheet
objExcel.ActiveWorkbook.Save
objExcel.ActiveWorkbook.Close
set objExcel = Nothing
On Error Goto 0
End Sub
Function GetGoogleLink(strSearchKeyword)
On Error Resume Next
Dim objExplorer
Dim arrKeywords
Dim strURL
strURL = "://www.google.co.in/search?hl=en&q="
arrKeywords = Split(strSearchKeyword,chr(32))
For i =0 To UBound(arrKeywords)
strURL = strURL & arrKeywords(i) & "+"
Next
strURL = Mid(strURL,0,Len(strURL)-1) & "&meta="
Set objExplorer = WScript.CreateObject("InternetExplorer.Application")
objExplorer.Navigate(strURL)
do
WScript.Sleep(100)
Loop while objExplorer.Busy = True
strInnerText = objExplorer.Document.body.innerHTML
strStartPosition = InStr(strInnerText, "class=g")
strLinkStart = InStr(strStartPosition, strInnerText, "href=")
strLink = Mid(strInnerText, strLinkStart + 6, InStr(strLinkStart +
6, strInnerText, chr(34))- strLinkStart-6)
GetGoogleLink = strLink
On Error Goto 0
End Function
Function IsFileOpen(ByVal sFileName)
Dim file
Dim iErrNum
Dim objFSO
Const ForAppending = 8
On Error Resume Next
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
' Attempt to open the file and lock it.
Set file = objFSO.OpenTextFile(sFileName, ForAppending, False)
iErrNum = Err.Number ' Save the error number that occurred.
file.Close ' Close the file.
On Error GoTo 0 ' Turn error checking back on.
' Check to see which error occurred.
Select Case iErrNum
' No error occurred.
' File is NOT already open by another user.
Case 0
IsFileOpen = False
' Error number for "Permission Denied."
' File is already opened by another user.
Case 70 ' Error number for "Permission Denied."
IsFileOpen = True
' Another error occurred.
Case Else
Set objFSO = Nothing
Err.Raise iErrNum
End Select
Set objFSO = Nothing
End Function |
