Associate the Zodiac with Your Day Horoscope Extract from an Internet Page in VBA
Good morning to all my name is A.Maurizio
And my question and this: Time ago I was able to create a program entirely in VBA
Using an Excel sheet, where I was looking for the zodiac sign I wanted through a ComboBox, and then pressing a button I called my Horoscope.
Everything using this Code:
Code:
Private Sub Cmd_AvviaOroscopo_Click()
On Error Resume Next
Range("F2").Value = "" & ListBox1.Text
'vSegno = Target
vSegno = Range("J2").Value & ""
Range("F2").Value = "" & Oroscopo(vSegno)
End Sub
And then in the Module I wrote this:
Code:
Public Function Oroscopo(ByVal vSegno As Variant) As String
Dim sSource As String
Dim aSegni As Variant
Dim j As Integer
Dim sSegno As String
Dim nSegno As Integer
Dim sOroscopo As String
Dim Http1 As Object
Dim sUrl As String
Dim nAtH2 As Long
Dim nAtP As Long
Dim nAtCP As Long
On Error GoTo Oroscopo_Error
aSegni = Split("Ariete Toro Gemelli Cancro Leone Vergine Bilancia Scorpione Sagittario Capricorno Acquario Pesci")
If IsNumeric(vSegno) Then
nSegno = vSegno
sSegno = aSegni(nSegno - 1)
Else
sSegno = vSegno
For j = 0 To 11
If aSegni(j) = sSegno Then
nSegno = j + 1
End If
Next
End If
Set Http1 = CreateObject("MSXML2.XMLHTTP")
sUrl = "http://oroscopo.donnad.it/oroscopo/settimanale/segno/s/" & nSegno
Http1.Open "GET", sUrl, False
Http1.Send
sSource = Http1.ResponseText
Set Http1 = Nothing
nAtH2 = InStr(1, sSource, "</h2>", vbTextCompare)
nAtP = InStr(nAtH2, sSource, "<p>", vbTextCompare) + 3
nAtCP = InStr(nAtP, sSource, "</p>", vbTextCompare) - nAtP
sOroscopo = VBA.Mid(sSource, nAtP, nAtCP)
sOroscopo = sSegno & vbCrLf & VBA.Trim(Replace(Replace(Replace(sOroscopo, vbLf, ""), vbCr, ""), vbTab, ""))
Oroscopo_Error:
If Err.Number <> 0 Then
Set Http1 = Nothing
sOroscopo = "Non disponibile!"
End If
Oroscopo = sOroscopo
End Function
Now All That Worked Well Up To Some Years ago; Then nothing happens to me since then.
I also tried to change the Address of the Connected Internet Site, thinking that the page with Time was Expired; But nothing to do.
Here is my question and this: There would not be another way more to view it all without adopting my Criterion.
Thank you for all the help you want to give me, Sincerely greetings from A.Maurizio
(P.S) Anyway For More Information I Insert My Test Project
Last edited by A.Maurizio; May 12th, 2017 at 10:54 AM.
3) in the loop For j = 0 to 11 add a Exit For after the value is found:
Code:
If IsNumeric(vSegno) Then
nSegno = vSegno
sSegno = aSegni(nSegno - 1)
Else
sSegno = vSegno
For j = 0 To 11
If aSegni(j) = sSegno Then
nSegno = j + 1
Exit For ' <---------------------------------
End If
Next
End If
Re: Associate the Zodiac with Your Day Horoscope Extract from an Internet Page in VBA
I thank you gibra but first I still understand something with this link I absolutely do not understand anything.
But that's fine.
Thanks anyway, Sincere greetings from A.Maurizio