24

I am looking for a reputable free tool to export results of a keyword search on Google Scholar to Microsoft Word or Excel.

I am in the process of assembling a reading list for systematic literature review. In Google Scholar, I get 276 results for my keyword search. I need to perform and record two culls firstly on title, then on abstract reading, leaving myself with a potential reading list.

I would like to do this in Excel or Word, if possible. I found an article in the Search Engine Journal, recommending "SEO PowerSuite", but the article is from 2009 and my antivirus software is recommending not running the downloaded executable.

I am very new to research, so could you point me in the right direction of discovering and using reputable free tools that would allow me to export my Google Scholar keyword search results?

closed as off-topic by Herman Toothrot, user3209815, David Richerby, Florian D'Souza, nengel Feb 27 '18 at 10:23

This question appears to be off-topic. The users who voted to close gave this specific reason:

If this question can be reworded to fit the rules in the help center, please edit the question.

  • 3
    Some antiviruses enter in paranoid mode and would recommend not running almost anything, unless it comes signed by Microsoft or one other big company. If you think you got the program from a reputable web, it is likely to be safe, but you can run it in a virtual machine to be safer. – Davidmh Sep 21 '15 at 12:58
  • Ok thanks David, I did wonder about that. I would have expected the Search Engine Journal to be fairly reputable! – Hilary Sep 21 '15 at 13:46
  • 1
    I'm voting to close this question as off-topic because it belongs to softwarerecs.stackexchange.com – adipro Aug 11 '16 at 20:16
  • Thanks for the steer @adipro, I was still reasonably new to stack exchange and mainly using stack overflow when I asked the question. – Hilary Aug 12 '16 at 13:46
  • 4
    @Davidmh I would be careful about that kind of advice. Once I had my antivirus warn me about a program downloaded from sourceforge. I thought "hey, SF is reliable, it's probably a false-positive" (and the devs of the program in question are also known to be reliable). Turns out SF changed owners and is now randomly shipping malware with the programs you download through them, and I had to jump through hoops to remove the garbage it installed. So don't ignore your antivirus because you think you downloaded something from a reliable source. – user9646 Aug 24 '16 at 16:40
19

Check out Publish or Perish. You can run keyword queries on Google Scholar from there, and export the results to .csv, which you can later open from Excel

  • do you know for web of science? – SSimon Feb 25 '18 at 10:23
  • The Web of Science lets you export data as a tabulated text file. After you make any query in Web of Science Core Collection, you click on the dropdown menu located before the first result, select Save to Other File Formats, then you select the fields you want (the easiest way is to select full record), then the format (tab-delimited). You can export up to 500 records in one go, so if you need more you can do 1-500, 501-1000... then you can import those files to Excel, and merge all results in a single file. – alberto Feb 26 '18 at 11:58
  • I saw at some conferences, and demonstration, that researchers make histograms of topic published per year. For example, pervoskite, or hiv vaccine or Dl mutation etc, and then you see brake of keywords, or topic, published per year. number of articles in one period of time. Is this possible? – SSimon Feb 26 '18 at 15:50
9

I do not know a tool for that, but I suggest the following, having Excel in Windows:
1. Write your queries (keywords) in the A column in a sheet of the document
2. Hit Alt+F11 to open Vba editor, then click with the mouse right button on the left panel in VBAProject, then, insert module.
3. Copy and paste the code (see below) in the module blank space.
4. Go to the "Tools" menu, "references", and select: Microsoft Internet controls, Microsoft HTML object library AND Microsoft VBscripts Regular Expressions 5.5. Use Ctrl+G to open progress window.
5. Put the cursor in the code after Sub..., click on the play button up in the module (code) window or hit F5 to run it.
6. It is recommendend to open Internet Explorer before running (can be closed again) or use Browser.Visible = True the first time you use it.
An option to get doi numbers was added, look for the button after searching.

'Go to the Tools menu, references, and select Microsoft Internet controls,
'Microsoft HTML object library AND Microsoft VBscripts Regular Expressions 5.5.
Public t As Range ' variables used in several subs
Public btn As Button
Public myproxy As Variant
Public Function Ceiling(ByVal X As Double, Optional ByVal Factor As Double = 1) As Double
Ceiling = (Int(X / Factor) - (X / Factor - Int(X / Factor) > 0)) * Factor
End Function
Sub scholargooglegetresults() '
Application.ScreenUpdating = False
Call main
' IMPORTANT               IMPORTANT             IMPORTANT
' CLICK THE PLAY BUTTON HAVING CURSOR here AND YOUR QUERIES ON COLUMN A
Application.SendKeys "%{F11}"
ActiveWindow.Zoom = 60
Application.ScreenUpdating = True
Range("D4").Select
End Sub
Sub main()
Dim Browser As InternetExplorer
Dim Document As IHTMLDocument
Dim DElements As IHTMLElementCollection
Dim DElement As IHTMLElement
Dim DElements2 As IHTMLElementCollection
Dim DElement2 As IHTMLElement
Dim DElements3 As IHTMLElementCollection
Dim DElement3 As IHTMLElement
Dim strIn As String
Dim objRegex2 As Object
Dim myValue As Variant
Dim crange As Range
Dim arr
Dim arraya(), a As Long
Set Browser = New InternetExplorer
Browser.Visible = False '                       <- Browser visibility
ActiveSheet.Buttons.Delete
lastRow = Range("A" & Rows.Count).End(xlUp).Row
myValue = InputBox("Consider it takes approx 2 sec per result (cite), 100 cites = 200 secs", "How many results per query ?", 1)
If StrPtr(myValue) = False Then
MsgBox ("Alt F11 to show vba editor!")
Exit Sub
End If
If IsNumeric(myValue) = False Then
MsgBox ("Please fill a number!")
Exit Sub
Else
myNumber = Ceiling(myValue / 10) * 10
Application.SendKeys "%{F11}"
timeest = (myNumber * lastRow * 2.2) '
MsgBox ("Click ok and wait approx. " & timeest & " seconds!, you will see this sheet again filled"), 0, ("Click ok and be patient")
End If
ActiveSheet.Columns(3).ClearContents
Range("C10") = 0
Range("C10").Select
Selection.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
Step:=10, Stop:=myValue - 1, Trend:=False
lastrow2 = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
ActiveSheet.Range("C10:C" & lastrow2).Select
If Selection.Cells.Count > 1 Then
arr = Join(Application.Transpose(Selection.Value), ",")
Range("C9") = arr
For a = 0 To UBound(Split(arr, ","))
ReDim Preserve arraya(a)
arraya(a) = CInt(Split(arr, ",")(a))
Next a
Else
arr = 0
ReDim Preserve arraya(a)
arraya(a) = arr
End If
c = 1
k = 6
Cells(1, k - 2).EntireColumn.ColumnWidth = 20
Cells(1, k - 1).EntireColumn.ColumnWidth = 20
Cells(1, k + 1).EntireColumn.ColumnWidth = 20
Cells(1, k).EntireColumn.ColumnWidth = 25
Cells(1, k + 2).EntireColumn.ColumnWidth = 20
Cells(1, k + 3).EntireColumn.ColumnWidth = 20
Cells(1, k + 4).EntireColumn.ColumnWidth = 75
Cells(1, k + 5).EntireColumn.ColumnWidth = 75
Cells(1, k + 6).EntireColumn.ColumnWidth = 25
Cells(1, k + 7).EntireColumn.ColumnWidth = 25
Cells(1, 1).EntireColumn.ColumnWidth = 21 ' changing width of columns to visualize better
Cells(1, 2).EntireColumn.ColumnWidth = 25
For i = 1 To lastRow ' for every of your queries in column A
j = 0
Url = "https://scholar.google.com"
Browser.navigate Url
Do While Browser.Busy And Not Browser.readyState = READYSTATE_COMPLETE
DoEvents
Loop
Set Document = Browser.Document
'Application.Wait (Now + TimeValue("0:00:07")) 'was 7
Application.Wait (Now + TimeSerial(0, 0, WorksheetFunction.RandBetween(15, 25)))
Document.all.q.Value = Cells(i, 1)
Do While Browser.Busy And Not Browser.readyState = READYSTATE_COMPLETE
DoEvents
Loop
Set Elements = Document.getElementsByTagName("button")
For Each Element In Elements
If Element.Type = "submit" Then
Element.Click
Exit For
End If
Next Element
Do While Browser.Busy And Not Browser.readyState = READYSTATE_COMPLETE
DoEvents
Loop
For a = LBound(arraya) To UBound(arraya)
Debug.Print arraya(a) + 10 & " Results obtained for: "" " & Cells(i, 1) & " "" Wait please "
Set Elements = Document.getElementsByClassName("gs_btnPR gs_in_ib gs_btn_half")
For Each Element In Elements
If Element.Type = "button" Then
Element.Click
Exit For
End If
Application.Wait (Now + TimeSerial(0, 0, WorksheetFunction.RandBetween(15, 25)))
Next Element
Do While Browser.Busy And Not Browser.readyState = READYSTATE_COMPLETE
DoEvents
Loop
Application.Wait (Now + TimeSerial(0, 0, WorksheetFunction.RandBetween(15, 25)))
Set DElements = Document.getElementById("gs_res_ccl_mid").getElementsByClassName("gs_r gs_or gs_scl") ' gsri
If DElements.Length = 0 Then
Exit For
End If
For Each DElement In DElements
c = c + 1 '+ '((myNumber) * (i - 1)) ' number of row with author and year
j = j + 1 '+ (myNumber * i - 1) ' result number
On Error Resume Next
Set DElements2 = DElement.getElementsByTagName("div")
For Each DElement2 In DElements2
If DElement2.className = "gs_a" Then
Cells(c, k + 1) = DElement2.innerText 'author year
Cells(c, k + 2).FormulaR1C1 = "=IF(ISNUMBER(VALUE(IFERROR(MID(RC[-1], FIND(""19"",RC[-1]), 4),"""")))=TRUE,IF(VALUE(IFERROR(MID(RC[-1], FIND(""19"",RC[-1]), 4),""""))>=1900,IFERROR(MID(RC[-1], FIND(""19"",RC[-1]), 4),""""),IF(ISNUMBER(VALUE(IFERROR(MID(RC[-1], FIND(""20"",RC[-1]), 4),"""")))=TRUE,IF(VALUE(IFERROR(MID(RC[-1], FIND(""20"",RC[-1]), 4),""""))>=2000,IFERROR(MID(RC[-1], FIND(""20"",RC[-1]), 4),""""),""year not detected""),""year not detected"")),IF(ISNUMBER(VALUE(IFERROR(MID(RC[-1], FIND(""20"",RC[-1]), 4),"""")))=TRUE,IF(VALUE(IFERROR(MID(RC[-1], FIND(""20"",RC[-1]), 4),""""))>=2000,IFERROR(MID(RC[-1], FIND(""20"",RC[-1]), 4),""""),""year not detected""),""year not detected""))" ' formula to get year from string
Cells(c, k + 2).Value = Cells(c, k + 2).Value ' eliminate formula, leave year as number
Cells(c, k - 2) = Cells(i, 1).Value ' search
Cells(c, k - 1) = j ' result number
Cells(c, k + 3).FormulaR1C1 = "=RIGHT(LEFT(RC[-2],FIND("" "",RC[-2],(FIND("" "",RC[-2],1))+1)-1),(FIND("" "",RC[-2],(FIND("" "",RC[-2],1))+1)-FIND("" "",RC[-2],1))-1)" ' "=RIGHT(RC[-2],SEARCH("" "",RC[-2])-1)"   'concatenate(RC[+1],R[+1]C[+1],R[+2]C[+1],R[+3]C[+1],R[+4]C[+1])"
'   ElseIf DElement2.className = "gs_md_wp gs_ttss" Then
ElseIf DElement2.className = "gs_ggs gs_fl" Then ' gs_ggs gs_fl
Set link = DElement2.getElementsByTagName("a")(0)
Cells(c, k + 6) = link.href ' link to pdf
Set link = Null
ElseIf DElement2.className = "gs_rs" Then ' text big
Cells(c, k + 5) = DElement2.innerText
End If
Next
Set DElements3 = DElement.getElementsByTagName("h3")
For Each DElement3 In DElements3
If DElement3.className = "gs_rt" Then
Cells(c, k + 4) = DElement3.innerText
strIn = Cells(c, k + 4).Text
Set objRegex2 = CreateObject("vbscript.regexp")
With objRegex2
.Global = True
.Pattern = "\[\w*\]\s?"
If .test(strIn) Then
    Cells(c, k + 4).Value = .Replace(strIn, vbNullString) ' eliminate [HTML] [PDF] strings
End If
End With
Set link = DElement3.getElementsByTagName("a")(0)
Cells(c, k + 7) = link.href
Set link = Null
End If
Next ' DElement3
Next 'DElement
Next ' for url
Next
Set Document = Nothing
Set Browser = Nothing
Cells(1, 2) = "Each time each type of sort button is clicked, changes from Ascending to Descending" ' additional help
Cells(2, 2) = "PDF and IExplorer Issues:"
Cells(3, 2) = "https://www.itsupportguides.com/windows-7/adobe-pdfs-wont-open-in-internet-explorer/"
Cells(4, 2) = "https://helpx.adobe.com/acrobat/kb/epm-support-acrobat-products.html"
Cells(8, 2) = "https://gen.lib.rus.ec"
Cells(9, 2) = "Search dois in crossref (wait 1.5 seconds per ref)"
Cells(10, 2) = "Use dois to get .bib refs,"
Cells(11, 2) = "as in:"
Cells(12, 2) = "http://stackoverflow.com/questions/1781672/convert-bibliographic-references-from-a-document-into-bibtex-or-endnote/39820830#39820830"
Cells(13, 2) = "Beggining in step 4."
Range("A1").Resize(Cells.Find(what:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
Cells.Find(what:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Column).Select ' selecting all to wrap text
With Selection
.WrapText = True
End With
With ActiveSheet
Range("B1").Select
lastrow3 = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
ActiveSheet.Range("B1:B" & lastrow3).Select
For Each xCell In Selection
If InStr(1, xCell.Value, "http") > 0 Then
ActiveSheet.Hyperlinks.Add anchor:=xCell, Address:=xCell.Value
End If
Next xCell
End With
Call research
Call header
End Sub
Sub header() ' create headers in first row
lastRow = Range("A" & Rows.Count).End(xlUp).Row
k = 6 '7 * i - 2 ' k refers to column corresponding to i - your query
Cells(1, k) = "Order by your notes" '  main column title (button text)
Cells(1, k - 2) = "your search" ' year column title (button text)
Cells(1, k - 1) = "Button to Reset to original ordering" '  main column title (button text)
Cells(1, k + 1) = "Authors, year, editor" ' year column title (button text)
Cells(1, k + 2) = " Button - use to order by YEAR" ' year column title (button text)
Cells(1, k + 3) = "First author" ' year column title (button text)
Cells(1, k + 4) = "Title" ' year column title (button text)
Cells(1, k + 5) = "text" ' year column title (button text)
Cells(1, k + 6) = " Link 1" ' year column title (button text)
Cells(1, k + 7) = " Link 2" ' year column title (button text)
Cells(1, k + 9) = " dois, after using crossref button" ' year column title (button text)
Range(Cells(1, 3), Cells(1, 3)).EntireColumn.Hidden = True 'cells in "C" used for ordering purposes hidden
Range("A1").Resize(Cells.Find(what:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
Cells.Find(what:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Column).Select ' selecting all to wrap text
With Selection
.WrapText = True
End With
Rows("2:2").Select ' to freeze top row
ActiveWindow.FreezePanes = True
' to Reset to original ordering" CREATING BUTTON
Set t = ActiveSheet.Cells(1, k - 1)
Set btn = ActiveSheet.Buttons.Add(t.Left + 5, t.Top + 5, t.Width - 7, t.Height - 7)
With btn
.OnAction = "sortbyscholarorder"
.Caption = Cells(1, k - 1).Value
.Name = "sortbyscholarorder" & 1 & k - 1
End With
' to dois " CREATING BUTTON
Set t = ActiveSheet.Cells(9, 2)
Set btn = ActiveSheet.Buttons.Add(t.Left + 5, t.Top + 5, t.Width - 7, t.Height - 7)
With btn
.OnAction = "cross"
.Caption = Cells(9, 2).Value
.Name = "cross" & 9 & 2
End With
'  use to order by YEAR" CREATING BUTTON
Set t = ActiveSheet.Cells(1, k + 2)
Set btn = ActiveSheet.Buttons.Add(t.Left + 5, t.Top + 5, t.Width - 7, t.Height - 7)
With btn
.OnAction = "sortbyyear"
.Caption = Cells(1, k + 2).Value
.Name = "sortbyyear" & 1 & k + 2
End With
' order BY your notes
Set t = ActiveSheet.Cells(1, k)
Set btn = ActiveSheet.Buttons.Add(t.Left + 5, t.Top + 5, t.Width - 7, t.Height - 7)
With btn
.OnAction = "orderbynotes"
.Caption = Cells(1, k).Value
.Name = "orderbynotes" & 1 & k
End With
Set t = Cells(5, 2)
Set btn = ActiveSheet.Buttons.Add(t.Left + 2, t.Top + 2, t.Width - 2, t.Height - 2)
With btn
.OnAction = "modifylinks"
.Caption = "Add proxy, e.g. sci-hub"
.Name = "addproxy"
End With
Set t = Cells(6, 2)
Set btn = ActiveSheet.Buttons.Add(t.Left + 2, t.Top + 2, t.Width - 2, t.Height - 2)
With btn
.OnAction = "removeproxy"
.Caption = "remove proxy in links"
.Name = "removeproxybutton"
End With
With ActiveSheet
Range("L1").Resize(Cells.Find(what:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
Cells.Find(what:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Column).Select
For Each xCell In Selection ' transforming cell content with link info to working hyperlinks
If InStr(1, xCell.Text, "researchgate.net/profile") > 0 Then
ElseIf InStr(1, xCell.Value, "http") > 0 Then
ActiveSheet.Hyperlinks.Add anchor:=xCell, Address:=xCell.Value
ElseIf InStr(1, xCell.Value, "ftp://") > 0 Then
ActiveSheet.Hyperlinks.Add anchor:=xCell, Address:=xCell.Value
End If
Next xCell
End With
Range("A1").Select
End Sub
Sub ResetFilters()
On Error Resume Next
ActiveSheet.ShowAllData
End Sub
Sub sortbyyear() 'action taken by the sort by year button
Application.ScreenUpdating = False
Call ResetFilters
Dim buttonrow As Long, buttonrange As Range, buttonrangeresized As Range
buttonrow = ActiveSheet.Buttons(Application.Caller).TopLeftCell.Row
buttoncolumn = ActiveSheet.Buttons(Application.Caller).TopLeftCell.Column
Set buttonrange = ActiveSheet.Range(Cells(buttonrow, buttoncolumn), Cells(buttonrow, buttoncolumn)) ' range with coordinates of clicked button
buttonrange.Select
Selection.Resize(1, 12).Select ' expand range to be sorted
Selection.Offset(0, -4).Select
Selection.EntireColumn.Select
Set buttonrangeresized = Selection
ActiveSheet.Buttons.Delete
If Cells(2, 3).Value Mod 2 = 0 Then
With buttonrangeresized
.Sort _
Key1:=Cells(buttonrow, buttoncolumn + 0), Order1:=xlAscending, header:= _
xlYes, Orientation:=xlTopToBottom, DataOption1:= _
xlSortTextAsNumbers, _
Key2:=Cells(buttonrow, buttoncolumn - 3), Order2:=xlAscending, header:= _
xlYes, Orientation:=xlTopToBottom, DataOption2:= _
xlSortTextAsNumbers, _
Key3:=Cells(buttonrow, buttoncolumn - 2), Order3:=xlAscending, header:= _
xlYes, Orientation:=xlTopToBottom, DataOption3:= _
xlSortTextAsNumbers
Cells(2, 3) = Cells(2, 3) + 1 ' cell C2 stores the number of clicks done
End With
Else ' if button is clicked odd number of times order is Descending
With buttonrangeresized
.Sort Key1:=Cells(buttonrow, buttoncolumn + 0), Order1:=xlDescending, header:= _
xlYes, Orientation:=xlTopToBottom, DataOption1:= _
xlSortTextAsNumbers, _
Key2:=Cells(buttonrow, buttoncolumn - 3), Order2:=xlAscending, header:= _
xlYes, Orientation:=xlTopToBottom, DataOption2:= _
xlSortTextAsNumbers, _
Key3:=Cells(buttonrow, buttoncolumn - 2), Order3:=xlAscending, header:= _
xlYes, Orientation:=xlTopToBottom, DataOption3:= _
xlSortTextAsNumbers
Cells(2, 3) = Cells(2, 3) + 1 ' cell C2 stores the number of clicks done
End With
End If
Call research '
Call header '
Exit Sub '
End Sub
Sub sortbyscholarorder()
Application.ScreenUpdating = False
Call ResetFilters
Dim buttonrow As Long, buttonrange As Range, buttonrangeresized As Range
buttonrow = ActiveSheet.Buttons(Application.Caller).TopLeftCell.Row
buttoncolumn = ActiveSheet.Buttons(Application.Caller).TopLeftCell.Column
Set buttonrange = ActiveSheet.Range(Cells(buttonrow, buttoncolumn), Cells(buttonrow, buttoncolumn))
buttonrange.Select
k = 6
Selection.Resize(1, 12).Select
Selection.Offset(0, -1).Select
Selection.EntireColumn.Select
Set buttonrangeresized = Selection
ActiveSheet.Buttons.Delete
If Cells(5, 3).Value Mod 2 = 0 Then ' if button is clicked even number of times order is ascending
With buttonrangeresized
.Sort Key1:=Cells(buttonrow, buttoncolumn - 1), Order1:=xlAscending, header:= _
xlYes, Orientation:=xlTopToBottom, DataOption1:= _
xlSortTextAsNumbers, Key2:=Cells(buttonrow, buttoncolumn + 0), Order2:=xlAscending, header:= _
xlYes, Orientation:=xlTopToBottom, DataOption2:= _
xlSortTextAsNumbers, header:=xlYes
Cells(5, 3) = Cells(5, 3) + 1 ' number of clicks done
End With
Else ' if button is clicked odd number of times order is Descending
With buttonrangeresized
.Sort _
Key1:=Cells(buttonrow, buttoncolumn - 1), Order1:=xlDescending, header:= _
xlYes, Orientation:=xlTopToBottom, DataOption1:= _
xlSortTextAsNumbers, _
Key2:=Cells(buttonrow, buttoncolumn + 0), Order2:=xlAscending, header:= _
xlYes, Orientation:=xlTopToBottom, DataOption2:= _
xlSortTextAsNumbers, header:=xlYes '
Cells(5, 3) = Cells(5, 3) + 1 ' ' cell C1 stores the number of clicks done
End With
End If
Call research ' remake the researchgate buttons after sorting
Call header ' remake the header buttons
Exit Sub ' this is here to avoid getting the clicked button address when nothing is clicked
End Sub
Sub orderbynotes() 'action taken by the sort by your notes button
Application.ScreenUpdating = False
Call ResetFilters
Dim buttonrow As Long, buttonrange As Range, buttonrangeresized As Range
buttonrow = ActiveSheet.Buttons(Application.Caller).TopLeftCell.Row
buttoncolumn = ActiveSheet.Buttons(Application.Caller).TopLeftCell.Column
Set buttonrange = ActiveSheet.Range(Cells(buttonrow, buttoncolumn), Cells(buttonrow, buttoncolumn))
buttonrange.Select
Selection.Resize(1, 12).Select
Selection.Offset(0, -2).Select
Selection.EntireColumn.Select
Set buttonrangeresized = Selection
ActiveSheet.Buttons.Delete
If Cells(6, 3).Value Mod 2 = 0 Then
With buttonrangeresized
.Sort _
Key1:=Cells(buttonrow, buttoncolumn - 0), Order1:=xlAscending, header:= _
xlYes, Orientation:=xlTopToBottom, DataOption1:= _
xlSortTextAsNumbers, _
Key2:=Cells(buttonrow, buttoncolumn - 1), Order2:=xlAscending, header:= _
xlYes, Orientation:=xlTopToBottom, DataOption2:= _
xlSortTextAsNumbers, _
Key3:=Cells(buttonrow, buttoncolumn + 2), Order3:=xlAscending, header:= _
xlYes, Orientation:=xlTopToBottom, DataOption3:= _
xlSortTextAsNumbers
Cells(6, 3) = Cells(6, 3) + 1 ' number of clicks done
End With
Else ' if button is clicked odd number of times order is Descending
With buttonrangeresized
.Sort Key1:=Cells(buttonrow, buttoncolumn - 0), Order1:=xlDescending, header:= _
xlYes, Orientation:=xlTopToBottom, DataOption1:= _
xlSortTextAsNumbers, _
Key2:=Cells(buttonrow, buttoncolumn - 1), Order2:=xlAscending, header:= _
xlYes, Orientation:=xlTopToBottom, DataOption2:= _
xlSortTextAsNumbers, _
Key3:=Cells(buttonrow, buttoncolumn + 2), Order3:=xlAscending, header:= _
xlYes, Orientation:=xlTopToBottom, DataOption3:= _
xlSortTextAsNumbers
Cells(6, 3) = Cells(6, 3) + 1 ' cell C2 stores the number of clicks done
End With
End If
Call research '
Call header ' necessary to remake the header buttons
Exit Sub ' this is here to avoid getting the clicked button address when nothing is clicked
End Sub
Sub research() '
With ActiveSheet
Range("D1").Resize(Cells.Find(what:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
Cells.Find(what:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Column).Select
For Each xCell In Selection
If InStr(1, xCell.Text, "researchgate.net/profile") > 0 Then
Set btna = ActiveSheet.Buttons.Add(xCell.Left, xCell.Top, xCell.Width, xCell.Height)
With btna
    .OnAction = "researchgatebutton"
    .Caption = " OPEN RESEARCH GATE PDF LINK "
End With
End If
Next
End With
Range("A1").Select
End Sub
Sub researchgatebutton() '
Dim R As Range
Set R = ActiveSheet.Buttons(Application.Caller).TopLeftCell 'detect range (cell) of clicked button
R.Select
Set IE = CreateObject("Internetexplorer.Application")
IE.Visible = True
IE.navigate ActiveCell.Value
Exit Sub '
End Sub
Sub scihub() '
With ActiveSheet
Range("L1").Resize(Cells.Find(what:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
Cells.Find(what:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Column).Select
For Each xCell In Selection
If InStr(1, xCell.Text, ".sci-hub.") > 0 Then
Set btna = ActiveSheet.Buttons.Add(xCell.Left, xCell.Top, xCell.Width, xCell.Height)
With btna
.OnAction = "scihubbutton"
.Caption = " OPEN sci-hub PDF LINK " & Left(xCell.Text, 80) & " [truncated?]"
End With
End If
Next
End With
Range("A1").Select
End Sub
Sub scihubbutton() '
Dim R As Range
Set R = ActiveSheet.Buttons(Application.Caller).TopLeftCell '
R.Select
Set IE = CreateObject("Internetexplorer.Application")
IE.Visible = True
IE.navigate ActiveCell.Value
Exit Sub '
End Sub
Sub modifylinks()
If Cells(999, 3) = "" Then
myproxy = InputBox("Modify original URLs adding a proxy string? (If no, click Cancel)", _
"Which proxy do you use?", "sci-hub.tw")
If StrPtr(myproxy) = False Then
MsgBox ("Alt F11 to show vba editor!")
Application.SendKeys "%{F11}"
Exit Sub
End If
If myproxy = "" Then
MsgBox ("Alt F11 to show vba editor!")
Application.SendKeys "%{F11}"
Exit Sub
Else
Cells(999, 3) = myproxy
Call proxy
End If
Else
Call removeproxy
Call modifylinks
End If
End Sub
Sub proxy()
With ActiveSheet
Range("L1").Resize(Cells.Find(what:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
Cells.Find(what:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Column).Select
Dim lnk As Hyperlink, lnks As Hyperlinks
Set lnks = Selection.Hyperlinks
For i = 1 To lnks.Count
Set lnk = lnks(i)
If InStr(1, lnk.Range.Text, "researchgate") = 0 And _
InStr(1, lnk.Range.Text, "//") > 0 Then
strIn = lnk.Range.Text
Set objRegex3 = CreateObject("vbscript.regexp")
With objRegex3
.Global = False
.Pattern = "(https?:\/\/[A-Za-z0-9\.\-]+)(\/.*)"
If .test(strIn) Then
replacement = "$1." & myproxy & "$2"
lnk.Range.Value = .Replace(strIn, replacement)
ActiveSheet.Hyperlinks.Add anchor:=lnk.Range, Address:=lnk.Range.Value
End If
End With
End If
Next
End With
Call scihub
Range("D4").Select
End Sub
Sub removeproxy()
If Cells(999, 3) = "" Then
Exit Sub
Else
With ActiveSheet
Range("L1").Resize(Cells.Find(what:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
Cells.Find(what:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Column).Select
Dim lnk As Hyperlink, lnks As Hyperlinks
Set lnks = Selection.Hyperlinks
For i = 1 To lnks.Count
Set lnk = lnks(i)
theproxy = Cells(999, 3).Value
If InStr(1, lnk.Range.Text, "researchgate") = 0 And _
InStr(1, lnk.Range.Text, theproxy) > 0 Then
correct = Replace(lnk.Range.Text, "." & theproxy, "", , 1)
lnk.Range.Value = correct
ActiveSheet.Hyperlinks.Add anchor:=lnk.Range, Address:=lnk.Range.Value
End If
Next
End With
End If
Cells(999, 3) = ""
Range("D4").Select
Call DelButtons
Call research
Call header
End Sub
Sub DelButtons()
Dim btn As Shape
For Each btn In ActiveSheet.Shapes
If btn.AutoShapeType = msoShapeStyleMixed Then btn.Delete
Next
End Sub
Sub cross()
Application.ScreenUpdating = False
Dim IE As SHDocVw.InternetExplorer
Dim Doc As MSHTML.HTMLDocument
Dim Elements As MSHTML.IHTMLElementCollection
Dim TDelements As MSHTML.IHTMLElementCollection
Dim elements2 As MSHTML.IHTMLElementCollection
Dim htmlInput As MSHTML.HTMLInputElement
Dim Element As IHTMLElement
Dim TDelement As IHTMLElement
Dim objButton As MSHTML.IHTMLFormElement
Dim R As Integer
Dim c As Integer
Dim sentence As Variant
Dim sentence2 As Variant
Dim cSearch
Dim cSearch2
Dim snumber As Integer
snumber = 1
R = 0
Application.SendKeys "%{F11}"
For Each sentence In ActiveSheet.Range("I2", Range("I2").End(xlDown))
snumber = snumber + 1
R = R + 1
cSearch = sentence
      Debug.Print cSearch
cSearch2 = ActiveSheet.Range("J:J").Cells(0 + snumber)
Debug.Print cSearch2
cSearch3 = ActiveSheet.Range("H:H").Cells(0 + snumber) ' use for year
Debug.Print cSearch3
ActiveSheet.Range("N:N").Cells(0 + snumber).Value = "=BR" & snumber
ActiveSheet.Range("O:O").Cells(0 + snumber).Value = "=IF(ISERROR(REPLACE(RC[-1],1,FIND(""^^"",SUBSTITUTE(RC[-1],""/"",""^^"",3),1),""""))=TRUE,"""",REPLACE(RC[-1],1,FIND(""^^"",SUBSTITUTE(RC[-1],""/"",""^^"",3),1),""""))"
On Error Resume Next
Set IE = New SHDocVw.InternetExplorer
With IE
.Visible = False ' False
.navigate "http://www.crossref.org/guestquery"
Do Until Not .Busy And .readyState = 4
DoEvents
Loop
Set Elements = IE.Document.getElementsByTagName("Input")
For Each Element In Elements
If Element.Name = "auth" Then
Element.Value = cSearch
Exit For
End If
Next Element
Set elements2 = IE.Document.getElementsByTagName("Input")
For Each Element In Elements
If Element.Name = "atitle" Then
Element.Value = cSearch2
Exit For
End If
Next Element
'eliminate to not to use year
Set elements3 = IE.Document.getElementsByTagName("Input")
For Each Element In Elements
If Element.Name = "year" Then
Element.Value = cSearch3
Exit For
End If
Next Element
Do Until Not .Busy And .readyState = 4
DoEvents
Loop
Set Elements = IE.Document.getElementsByTagName("Input")
For Each Element In Elements
'     If Element.Name = "article_title_search" Then ' use if not using year
If Element.Name = "view_records" Then ' use when using year
Element.Click
Exit For
End If
Next Element
Do Until Not .Busy And .readyState = 4
DoEvents
Loop
Set TDelements = IE.Document.getElementsByTagName("td")
c = 1
For Each TDelement In TDelements
ActiveSheet.Range("O1").Offset(R, c).Value = TDelement.innerText
c = c + 1
Next
ActiveSheet.Range("N:N").Cells(0 + snumber) = ActiveSheet.Range("N:N").Cells(0 + snumber).Value
ActiveSheet.Range("O:O").Cells(0 + snumber) = ActiveSheet.Range("O:O").Cells(0 + snumber).Value
End With
Next sentence
Range("P1").Resize(Cells.Find(what:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
Cells.Find(what:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Column).Select '
With Selection
.Clear
End With
Application.ScreenUpdating = True
Call header
Call ddd
Exit Sub
Application.SendKeys "%{F11}"
End Sub
Function Contains(objCollection As Object, strName As String) As Boolean
Dim o As Object
On Error Resume Next
Set o = objCollection(strName)
Contains = (Err.Number = 0)
Err.Clear
End Function
Sub ddd()
Cells.Select
ActiveSheet.Range("O:O").Select
Selection.Copy
If Contains(Sheets, "dois") = False Then
Sheets.Add.Name = "dois"
End If
Sheets("dois").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:= _
"dois.csv", FileFormat:=xlCSV, _
CreateBackup:=False             '        IMPORTANT
'                         GO TO BEGINNING,     CLICK ON CODE AND CLICK THE PLAY BUTTON
End Sub

enter image description here enter image description here

6

Perhaps, some SEO tools can perform that task, but I am not too familiar with them. What I can suggest, though, is to use Web scraping for your purposes. However, note that going this route requires solid programming skills as well as decent amount time for testing and debugging.

Since you asked on Academia.SE, I assume that there is a relatively high probability that you are comfortable with computer programming. If you can work with Python, there is a scraping library BeautifulSoup. If you can work with R, there is a variety of approaches that can be used. For example, rvest package by Hadley Wickham. See this blog post for details and examples.

  • 5
    Yes, this is how it can be done. But note that if you hit scholar too frequently with something like this it will block you temporarily (for an hour or so). – David Ketcheson Sep 21 '15 at 12:58
  • @DavidKetcheson: Good point, thank you for mentioning. The easiest way to tackle this issue is to introduce artificial delays in the code. Considering the small amount of elements to parse in results, it will not be critical time-wise, but will allow to honor Google Scholar traffic limits. – Aleksandr Blekh Sep 21 '15 at 17:47
  • I think scraping violates the TOS: academia.stackexchange.com/a/3068/17331 – Luigi May 30 '16 at 18:21
  • 1
    @Luigi: Perhaps. But maybe not, considering the very recent precedent of Google winning against Oracle, based on playing the fair use card. It can be argued that scraping public information from Web pages is the case of the fair use. – Aleksandr Blekh May 30 '16 at 21:24
  • 2
    @Luigi: Throttling is not a problem, at least, from technical perspective - as I said above, simple delay scheme could honor the site's limitations, while still being able to download the information (unless its volume is too big to practically use this approach). As for academics not willing to fight with Google in court, you're right. However, on the other hand, I'm not sure whether Google would be interested in suing academics for such a minor offense, which very well might be considered and ruled as a valid case of fair use. Google's lawyers likely have more important things to work on. – Aleksandr Blekh May 31 '16 at 0:42

Not the answer you're looking for? Browse other questions tagged or ask your own question.