title: Using VBA macro in Excel to retrieve images of chemical structures from the NCI Chemical Identifier Resolver
body: <p>Based on the code given at <a href="http://depth-first.com/articles/2010/11/01/chemcell-easily-convert-names-and-cas-numbers-to-chemical-structures-in-excel/" rel="nofollow">this site</a> (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 <a href="http://cactus.nci.nih.gov/chemical/structure" rel="nofollow">http://cactus.nci.nih.gov/chemical/structure</a></p>
  
  <p>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</p>
  
  <pre><code>  XMLhttp.Open "GET", "http://cactus.nci.nih.gov/chemical/structure/" + name + "/image", False
  </code></pre>
  
  <p>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?</p>
  
  <p>Any advice would be much appreciated!</p>
  
  <p>cheers,
  Tom</p>
  
  <pre><code>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)) &lt; 33 Then
        last = i
      End If
    Next i
  
    If last &gt; 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
  </code></pre>