FollowHyperLink Macro not working with specific website

[ibTops]

Hi, I have the following, pretty straight forward macro:

Sub LoadLinks()

    Dim URL As String

    URL1 = Range("D31").Value

    URL2 = Range("B31").Value

    ActiveWorkbook.FollowHyperlink URL1

    ActiveWorkbook.FollowHyperlink URL2

 End Sub

D31 and B31 both have a concatenate formulas that form up different URLs. It's been working perfectly for months, but recently, the following URL is not working:

https://www.tmdn.org/

If I copy the value of the cell, go to Chrome and paste it manually, it loads no problem. Also, if I change the concatenate formula to say: Google, it works perfectly.

So basically, the macro works for other URLs and the URL I want is loading no problem when loading it manually/on any explorer. Maybe it's some sort of block that's been added to that specific website?

Thanks in advance!!

 

[mrshl9898]

This is working for me

Range("D21").Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True

But I cannot navigate to https://www.tmdn.org/

 

[ibTops]

So its this website in particular that isn't working then?? Please help someone

 

[daverunt]

I tried this using VBA Hyperlinks(1).Follow as per mrsh19898s post and it worked for a few goes with https://www.tmdn.org/ as well as working manually pasting or clicking on your link.
It then stopped working in either. I could not reach the site with VBA, when pasting into any of 3 browsers, or clicking on your link
While it was failing on my PC I tried it on my mobile, which would request it from a different IP address, and it worked repeatedly, however still failing in IE an Chrome on the PC so the site wasn't down.
Closing/cache clearing didn't make a difference.

It would be interesting if you found the issue.

 

[mrshl9898]

Had a similar experience, thought it was maybe an issue with the work PC but looks to be on the VBA Hyperlink side of things.

This works however... Maybe you can incorporate it?

Sub Automate_IE_Load_Page()
'This will load a webpage in IE
    Dim i As Long
    Dim URL As String
    Dim IE As Object
    Dim objElement As Object
    Dim objCollection As Object
 
    'Create InternetExplorer Object
    Set IE = CreateObject("InternetExplorer.Application")
 
    'Set IE.Visible = True to make IE visible, or False for IE to run in the background
    IE.Visible = True
 
    'Define URL
    URL = "https://www.tmdn.org/"
 
    'Navigate to URL
    IE.Navigate URL
 
    ' Statusbar let's user know website is loading
    Application.StatusBar = URL & " is loading. Please wait..."
 
    ' Wait while IE loading...
    'IE ReadyState = 4 signifies the webpage has loaded (the first loop is set to avoid inadvertently skipping over the second loop)
    Do While IE.ReadyState = 4: DoEvents: Loop   'Do While
    Do Until IE.ReadyState = 4: DoEvents: Loop   'Do Until
 
    'Webpage Loaded
    Application.StatusBar = URL & " Loaded"
    
    'Unload IE
    Set IE = Nothing
    Set objElement = Nothing
    Set objCollection = Nothing
    
End Sub

 

[ibTops]

Awesome mrshl9898, it seems to be working, thanks so much! Also thanks daverunt for your feedback and effort!

Does it have to open with IE? It can't be Chrome I'm guessing?

Also, could you please adjust it so it opens B31 and D31? I changed

URL = "https://www.tmdn.org/" to URL = Range("B31").Value

And then I did another version using: URL = Range("D31").Value

Then I recorded a Macro simply running both of those macros. This feels a bit unclean, sorry I'm a bit of a noob!!

Thank you sooo much!!

 

[mrshl9898]

Changing to the below works fine here, when D31 is https://www.tmdn.org/

URL = Range("B31").Value

To open both you could add a loop, or just add another code. Renaming Automate_IE_Load_Page

Automate_IE_Load_Page1
Automate_IE_Load_Page2

Sub Loadboth()
Automate_IE_Load_Page1
Automate_IE_Load_Page2
End Sub

Opening Chrome is pretty simple, from memory interacting with it can be a bit of a pain.

Just change this if needed with your Chrome.exe path

Sub gotochrome()

Dim URL As String
Dim URL2 As String

URL = Range("B31")
URL2 = Range("D31")

Shell ("C:\Program Files (x86)\Google\Chrome\Application\Chrome.exe -url " & URL)
Shell ("C:\Program Files (x86)\Google\Chrome\Application\Chrome.exe -url " & URL2)

End Sub