Mahakavi
03-09-2012, 11:01 PM
Sub getCTXML_phase_title_sponsor_official()
'
' Converts each text hyperlink selected into a working hyperlink
On Error Resume Next
ActiveWorkbook.Application.ScreenUpdating = False
Dim XMLDOC As New MSXML2.DOMDocument60
Dim xnodesls As IXMLDOMNodeList
Dim xnode As IXMLDOMNode
Dim addr As String
Dim Text As String
Dim xstring As String
Dim xstringPhase As String
Dim xstringSponsor As String
Dim xstringCondition As String
Dim xstringIntervention As String
Dim xstringInvestigator As String
Dim xstringTitle As String
Dim xstringStatus As String
Dim xCell As Range
For Each xCell In Selection
If InStr(xCell.Text, "NCT") Then
addr = "URL" + xCell.Formula + "?displayxml=true"
XMLDOC.async = False
XMLDOC.Load (addr)
Set xnodesls = XMLDOC.getElementsByTagName("phase")
xstringPhase = xnodesls.item(0).Text
Set xnodesls = XMLDOC.getElementsByTagName("official_title")
xstringTitle = xnodesls.item(0).ChildNodes(0).Text
Set xnodesls = XMLDOC.getElementsByTagName("lead_sponsor")
xstringSponsor = xnodesls.item(0).ChildNodes(0).Text
Set xnodesls = XMLDOC.getElementsByTagName("condition")
xstringCondition = xnodesls.item(0).ChildNodes(0).Text
Set xnodesls = XMLDOC.getElementsByTagName("intervention_name")
xstringIntervention = xnodesls.item(0).ChildNodes(0).Text
Set xnodesls = XMLDOC.getElementsByTagName("overall_official")
xstringInvestigator = xnodesls.item(0).ChildNodes(0).Text
Set xnodesls = XMLDOC.getElementsByTagName("overall_status")
xstringStatus = xnodesls.item(0).ChildNodes(0).Text
xCell.Offset(0, 1).Value = xstringPhase
xCell.Offset(0, 2).Value = xstringSponsor
xCell.Offset(0, 3).Value = xstringTitle
'xCell.Offset(0, 4).value = xstringPhase
xCell.Offset(0, 4).Value = xstringCondition
xCell.Offset(0, 5).Value = xstringIntervention
xCell.Offset(0, 6).Value = xstringInvestigator
'xCell.Offset(0, 6).value = xstringInvestigator '' delete me
xCell.Offset(0, 7).Value = xstringStatus
Application.StatusBar = xstring
End If
Next xCell
MsgBox ("done")
'
End Sub
I found the above code sometimes back in the web. When i ran the above code, it gives the following error
Compile error user-defined type not defined.
Note:
URL is clinicaltrials.gov web
ID numbers such as NCT00264901 etc were also added in the excel columns before running this macro. I think by means of NCT ID, this macro was written!
I am very new to Macro. Any help would be greatly appreciable. Thanks in advance!
'
' Converts each text hyperlink selected into a working hyperlink
On Error Resume Next
ActiveWorkbook.Application.ScreenUpdating = False
Dim XMLDOC As New MSXML2.DOMDocument60
Dim xnodesls As IXMLDOMNodeList
Dim xnode As IXMLDOMNode
Dim addr As String
Dim Text As String
Dim xstring As String
Dim xstringPhase As String
Dim xstringSponsor As String
Dim xstringCondition As String
Dim xstringIntervention As String
Dim xstringInvestigator As String
Dim xstringTitle As String
Dim xstringStatus As String
Dim xCell As Range
For Each xCell In Selection
If InStr(xCell.Text, "NCT") Then
addr = "URL" + xCell.Formula + "?displayxml=true"
XMLDOC.async = False
XMLDOC.Load (addr)
Set xnodesls = XMLDOC.getElementsByTagName("phase")
xstringPhase = xnodesls.item(0).Text
Set xnodesls = XMLDOC.getElementsByTagName("official_title")
xstringTitle = xnodesls.item(0).ChildNodes(0).Text
Set xnodesls = XMLDOC.getElementsByTagName("lead_sponsor")
xstringSponsor = xnodesls.item(0).ChildNodes(0).Text
Set xnodesls = XMLDOC.getElementsByTagName("condition")
xstringCondition = xnodesls.item(0).ChildNodes(0).Text
Set xnodesls = XMLDOC.getElementsByTagName("intervention_name")
xstringIntervention = xnodesls.item(0).ChildNodes(0).Text
Set xnodesls = XMLDOC.getElementsByTagName("overall_official")
xstringInvestigator = xnodesls.item(0).ChildNodes(0).Text
Set xnodesls = XMLDOC.getElementsByTagName("overall_status")
xstringStatus = xnodesls.item(0).ChildNodes(0).Text
xCell.Offset(0, 1).Value = xstringPhase
xCell.Offset(0, 2).Value = xstringSponsor
xCell.Offset(0, 3).Value = xstringTitle
'xCell.Offset(0, 4).value = xstringPhase
xCell.Offset(0, 4).Value = xstringCondition
xCell.Offset(0, 5).Value = xstringIntervention
xCell.Offset(0, 6).Value = xstringInvestigator
'xCell.Offset(0, 6).value = xstringInvestigator '' delete me
xCell.Offset(0, 7).Value = xstringStatus
Application.StatusBar = xstring
End If
Next xCell
MsgBox ("done")
'
End Sub
I found the above code sometimes back in the web. When i ran the above code, it gives the following error
Compile error user-defined type not defined.
Note:
URL is clinicaltrials.gov web
ID numbers such as NCT00264901 etc were also added in the excel columns before running this macro. I think by means of NCT ID, this macro was written!
I am very new to Macro. Any help would be greatly appreciable. Thanks in advance!