Using VBA macro in Excel to retrieve images of chemical structures from the NCI Chemical Identifier Resolver

Question

Based on the code given at this site (see below) I would like to adapt some VBA Excel macros to convert chemical names to chemical structures in Excel using the NCI Chemical Identifier Resolver at http://cactus.nci.nih.gov/chemical/structure

In particular, I would like to extend the code to have an additional function to return me an image (GIF) of the structure, where the image of the structure should be retrieved from

  XMLhttp.Open "GET", "http://cactus.nci.nih.gov/chemical/structure/" + name + "/image", False

which should then be saved in the Excel sheet at the location from where the formula is called (possibly also resizing the row to fit the image that is returned). Any thought how this could be achieved?

Any advice would be much appreciated!

cheers, Tom

Private Function strip(ByVal str As String) As String
  Dim last

  For i = 1 To Len(str) Step 1
    If Asc(Mid(str, i, 1)) < 33 Then
      last = i
    End If
  Next i

  If last > 0 Then
    strip = Mid(str, 1, last - 1)
  Else
    strip = str
  End If
End Function

Public Function getSMILES(ByVal name As String) As String
  Dim XMLhttp: Set XMLhttp = CreateObject("MSXML2.ServerXMLHTTP")
  XMLhttp.setTimeouts 2000, 2000, 2000, 2000
  XMLhttp.Open "GET", "http://cactus.nci.nih.gov/chemical/structure/" + name + "/smiles", False
  XMLhttp.send

  If XMLhttp.Status = 200 Then
    getSMILES = strip(XMLhttp.responsetext)
  Else
    getSMILES = ""
  End If
End Function
Public Function getInChIKey(ByVal name As String) As String
  Dim XMLhttp: Set XMLhttp = CreateObject("MSXML2.ServerXMLHTTP")
  XMLhttp.setTimeouts 1000, 1000, 1000, 1000
  XMLhttp.Open "GET", "http://cactus.nci.nih.gov/chemical/structure/" + name + "/stdinchikey", False
  XMLhttp.send

  If XMLhttp.Status = 200 Then
    getInChIKey = Mid(strip(XMLhttp.responsetext), 10)
  Else
    getInChIKey = ""
  End If
End Function
Public Function getIUPAC(ByVal name As String) As String
  Dim XMLhttp: Set XMLhttp = CreateObject("MSXML2.ServerXMLHTTP")
  XMLhttp.setTimeouts 1000, 1000, 1000, 1000
  XMLhttp.Open "GET", "http://cactus.nci.nih.gov/chemical/structure/" + name + "/iupac_name", False
  XMLhttp.send

  If XMLhttp.Status = 200 Then
    getIUPAC = strip(XMLhttp.responsetext)
  Else
    getIUPAC = ""
  End If
End Function
Public Function getCAS(ByVal name As String) As String
  Dim XMLhttp: Set XMLhttp = CreateObject("MSXML2.ServerXMLHTTP")
  XMLhttp.setTimeouts 1000, 1000, 1000, 1000
  XMLhttp.Open "GET", "http://cactus.nci.nih.gov/chemical/structure/" + name + "/cas", False
  XMLhttp.send

  If XMLhttp.Status = 200 Then
    getCAS = Mid(XMLhttp.responsetext, 1, InStr(XMLhttp.responsetext, Chr(10)) - 1)
  Else
    getCAS = ""
  End If
End Function
Public Function getCASnrs(ByVal name As String) As String
  Dim XMLhttp: Set XMLhttp = CreateObject("MSXML2.ServerXMLHTTP")
  XMLhttp.setTimeouts 1000, 1000, 1000, 1000
  XMLhttp.Open "GET", "http://cactus.nci.nih.gov/chemical/structure/" + name + "/cas", False
  XMLhttp.send

  If XMLhttp.Status = 200 Then
    getCASnrs = Replace(XMLhttp.responsetext, Chr(10), "; ")
  Else
    getCASnrs = ""
  End If
End Function
Public Function getSYNONYMS(ByVal name As String) As String
  Dim XMLhttp: Set XMLhttp = CreateObject("MSXML2.ServerXMLHTTP")
  XMLhttp.setTimeouts 1000, 1000, 1000, 1000
  XMLhttp.Open "GET", "http://cactus.nci.nih.gov/chemical/structure/" + name + "/names", False
  XMLhttp.send

  If XMLhttp.Status = 200 Then
    getSYNONYMS = Replace(XMLhttp.responsetext, Chr(10), "; ")
  Else
    getSYNONYMS = ""
  End If
End Function

You have a space before the url in `getSMILES` function, if you remove that then it should work... And the `getInChIKey` works ok for me. — Sam, Dec 07 '13 at 19:38
`getIUPAC` also works for me. What errors are you receiving? — Sam, Dec 07 '13 at 19:47
Ha sorry with the space removed everything now works - the other errors also now magically disappeared somehow. Any thoughts about my other two questions by any chance? — Tom Wenseleers, Dec 07 '13 at 20:44
There is a link [here](http://www.excelforum.com/excel-programming-vba-macros/384071-download-png.html) that describes how to download a PNG file from the internet, hopefully you may be able to modify it? And inserting a picture shouldn't be an issue as you can just record a macro for that and view the code to get a hint. — Sam, Dec 07 '13 at 20:51
And replacing your new-line should be able to be done with `Replace(yourString, Chr(13),"; ")` Let me know if all this works for you and I'll add it as an answer. — Sam, Dec 07 '13 at 20:53
On a separate note, you should probably try to just post one question at a time :-) — Sam, Dec 07 '13 at 20:54
Hi Sam - many thanks - Replace(yourString, Chr(10),"; ") did the trick for my getCAS and getSYNONYMS function. I haven't quite figured out yet how to download the images - if you would happen to have a working solution to that please let me know (but I still need to look into the link you sent)! Thanks a lot for your advice! And sorry for asking several questions at once - I thought this would be something that would be useful for many chemists though! — Tom Wenseleers, Dec 07 '13 at 21:12

score 3 · Accepted Answer · edited May 23 '17 at 11:56

3

You can get the image using something similar to the following:

    Sub Run()
getImage ("iron")
End Sub

Public Function getImage(ByVal name As String) As String
  Dim imgURL As String
  Dim XMLhttp: Set XMLhttp = CreateObject("MSXML2.ServerXMLHTTP")
  XMLhttp.setTimeouts 1000, 1000, 1000, 1000
  imgURL = "http://cactus.nci.nih.gov/chemical/structure/" + name + "/image"

  XMLhttp.Open "GET", imgURL, False
  XMLhttp.send

  If XMLhttp.Status = 200 Then
   'It exists so get the image
    Sheets(1).Shapes.AddPicture imgURL, msoFalse, msoTrue, 100, 100, 250, 250
  Else
    '
  End If
End Function

I believe this could be further simplified to simply only use

Sheets(1).Shapes.AddPicture imgURL, msoFalse, msoTrue, 100, 100, 300, 300

instead of downloading the image the twice, and simply using an error handler to catch when image not found.

Reference:

Update:

Using the activesheet, and 300 pixels for width and height:

 ActiveSheet.Shapes.AddPicture imgURL, msoFalse, msoTrue, 100, 100, 300, 300

edited May 23 '17 at 11:56

Community

1
1

answered Dec 16 '13 at 18:49

Menelaos

23,508
18
90
155

Hey there! Many thanks for this - just tried with getImage("geraniol") and it just shows a blank line though. Any thoughts what might be wrong? http://cactus.nci.nih.gov/chemical/structure/geraniol/image does give you the image though... – Tom Wenseleers Dec 18 '13 at 01:31
Ha sorry it did download the image but it doesn't put it in the active sheet but just in the first sheet. How should I change this behaviour, so that it would put it in the active sheet where you put the formula, in the location of the cell in which you place the formula? (Maybe also adjusting the row height of the cell from which the formula is called as required, to make the rows fit the contents, in case one would like to place many structures below each other?) – Tom Wenseleers Dec 18 '13 at 01:50
(maybe resizing the picture by 30% or so could be nice too, to make the resolution appear a bit better on screen) – Tom Wenseleers Dec 18 '13 at 02:02
@Tom Wenseleers You can get the active sheet using the `ActiveSheet` variable. E.g. with 50 pixels added with width and height: `ActiveSheet.Shapes.AddPicture imgURL, msoFalse, msoTrue, 100, 100, 300, 300` – Menelaos Dec 18 '13 at 02:30
Many thanks - well, in fact I am not entirely sure it should be the active sheet - it should be the sheet from which the formula is called - or would that always be the same as the active sheet? – Tom Wenseleers Dec 18 '13 at 03:00

Using VBA macro in Excel to retrieve images of chemical structures from the NCI Chemical Identifier Resolver

1 Answers1