A person that is not longer around sent me the following VBA. When I first ran the code it worked until the web page was updated, now the code does not work.
The following is what the code should do. When I start the macro it would go to the website, enter in the first symbol then go to the DISTRIBUTION TAB.retrive
the first line of data under the DISTRIBUTION HISTORY HEADING which is the dates and the amount of dividends on the first line, then return the data to Excel
ss in columns B:I, then repeat the process for the next symbol which is in column A until it loops thru all 600 symbols. If you could look at the VBA and explain
what has happened I would appreciate it greatly as i use this as part of my research.
Max
Public Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" _
Alias "DeleteUrlCacheEntryA" _
(ByVal lpszUrlName As String) As Long
Public Sub getData()
Dim x As String
Dim y As Variant
Dim n As Integer
Dim rngSymbols As Range
Dim sym As Range
Dim mydata As Variant
Dim xmlhttp As Object
Dim theData()
Dim strURL As String
ActiveSheet.Range("b:z").ClearContents
Application.ScreenUpdating = False
Set xmlhttp = CreateObject("microsoft.xmlhttp")
Set rngSymbols = Range("Symbols")
For Each sym In rngSymbols
Application.StatusBar = "Processing: " & sym.Value & " | Row: " & sym.Row - 2 & " / " & rngSymbols.Rows.Count
strURL = "http://www.cefconnect.com/Details/Summary.aspx?ticker=" & sym.Value
DeleteUrlCacheEntry (strURL)
With xmlhttp
.Open "get", strURL, False
.send
x = .responsetext
End With
'parse down the response text to the one row fo the table you need
If InStr(1, x, "ctl000_contents_SummaryContainer_DistributionsTab_ucDistributions_gvMain_ctl01_ROCHeader") = 0 Then
x = ">Not Found</td>"
Else
x = Mid(x, InStr(1, x, "ctl00_contents_SummaryContainer_DistributionsTab_ucDistributions_gvMain_ctl01_ROCHeader"))
x = Mid(x, InStr(1, x, "</tr>") + 5)
x = Mid(x, 1, InStr(1, x, "</tr>"))
End If
'split the row into its elements
y = Split(x, "</td>")
ReDim theData(UBound)
'put each data element into an array
For n = 0 To UBound
theData = Mid(y, InStrRev(y, ">") + 1)
If theData = 0 Then theData = ""
Next n
sym.Offset(0, 1).Resize(1, UBound(theData)) = theData
Next sym
ActiveSheet.UsedRange.Columns.AutoFit
Application.StatusBar = False
Application.ScreenUpdating = True
Set xmlhttp = Nothing
End Sub
The following is what the code should do. When I start the macro it would go to the website, enter in the first symbol then go to the DISTRIBUTION TAB.retrive
the first line of data under the DISTRIBUTION HISTORY HEADING which is the dates and the amount of dividends on the first line, then return the data to Excel
ss in columns B:I, then repeat the process for the next symbol which is in column A until it loops thru all 600 symbols. If you could look at the VBA and explain
what has happened I would appreciate it greatly as i use this as part of my research.
Max
Public Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" _
Alias "DeleteUrlCacheEntryA" _
(ByVal lpszUrlName As String) As Long
Public Sub getData()
Dim x As String
Dim y As Variant
Dim n As Integer
Dim rngSymbols As Range
Dim sym As Range
Dim mydata As Variant
Dim xmlhttp As Object
Dim theData()
Dim strURL As String
ActiveSheet.Range("b:z").ClearContents
Application.ScreenUpdating = False
Set xmlhttp = CreateObject("microsoft.xmlhttp")
Set rngSymbols = Range("Symbols")
For Each sym In rngSymbols
Application.StatusBar = "Processing: " & sym.Value & " | Row: " & sym.Row - 2 & " / " & rngSymbols.Rows.Count
strURL = "http://www.cefconnect.com/Details/Summary.aspx?ticker=" & sym.Value
DeleteUrlCacheEntry (strURL)
With xmlhttp
.Open "get", strURL, False
.send
x = .responsetext
End With
'parse down the response text to the one row fo the table you need
If InStr(1, x, "ctl000_contents_SummaryContainer_DistributionsTab_ucDistributions_gvMain_ctl01_ROCHeader") = 0 Then
x = ">Not Found</td>"
Else
x = Mid(x, InStr(1, x, "ctl00_contents_SummaryContainer_DistributionsTab_ucDistributions_gvMain_ctl01_ROCHeader"))
x = Mid(x, InStr(1, x, "</tr>") + 5)
x = Mid(x, 1, InStr(1, x, "</tr>"))
End If
'split the row into its elements
y = Split(x, "</td>")
ReDim theData(UBound)
'put each data element into an array
For n = 0 To UBound
theData = Mid(y, InStrRev(y, ">") + 1)
If theData = 0 Then theData = ""
Next n
sym.Offset(0, 1).Resize(1, UBound(theData)) = theData
Next sym
ActiveSheet.UsedRange.Columns.AutoFit
Application.StatusBar = False
Application.ScreenUpdating = True
Set xmlhttp = Nothing
End Sub