Radfahren durch Liste der URLs

Question

Dieser Code funktioniert gut beim Radfahren durch URLs wie Google, Yahoo, ect Aber ich bin wirklich versucht, durch die Webseiten wie hier gezeigt Zyklus.

\\FMC9050101\Proj\6513_OAK3\Jobads\slide1.htm 
\\FMC9050101\Proj\6513_OAK3\Jobads\slide2.htm 
\\FMC9050101\Proj\6513_OAK3\Jobads\slide3.htm 

Die erste Webseite up perfekt öffnet, aber ich erhalte und Automation Error „Das aufgerufene Objekt wurde von den Clients getrennt“ auf dieser Linie, wie die nächste Seite in radelte ist ... die Idee ist, zu ersetzen, die bestehende Seite, ohne eine neue Registerkarte zu öffnen.

While .Busy Or .ReadyState <> 4: DoEvents: Wend 

**** Code ***

Dim wsSheet As Worksheet, Rows As Long, links As Variant, IE As Object, link As Variant 
Set wb = ThisWorkbook 
Set wsSheet = wb.Sheets("Sheet1") 

Set IE = New InternetExplorer 

Rows = wsSheet.Cells(wsSheet.Rows.Count, "A").End(xlUp).Row 
links = wsSheet.Range("A1:A" & Rows) 

With IE 
    .Visible = True 
    For Each link In links 
     .navigate (link) 
     While .Busy Or .ReadyState <> 4: DoEvents: Wend 
     MsgBox .Document.body.innerText 
    Next link 
End With 

Answer 1

Okay, die Strategie geändert, wo ich die Liste der URLs von einem Server Verse ein Excel-Blatt lese, das ist, wo ich gehen mit diesem wurde nachdem die anderen Probleme aussortiert wurden. Mit einem Admin-Account funktioniert diese Version einwandfrei.

Sub Run_SlideShow() 
' 
Dim x As Integer 
Dim wsSheet As Worksheet, Rows As Long, links As Variant, IE As Object, link 
As Variant 
Dim FilePath As String, Filter As String, F As Variant, I As Integer 
' 
Application.Calculation = xlCalculationManual 
Application.ScreenUpdating = False 
Application.EnableEvents = True 
' 
Set wb = ThisWorkbook 
Set wsSheet = wb.Sheets("Sheet2") 
Filter = "*.htm" 
Set IE = CreateObject("Internetexplorer.Application") 
IE.Visible = False 
FilePath = "\\FMC9050101\PROJ\6513_OAK3\Jobads" 

For x = 1 To 9999 ' run for 30 hours, use scheduled task to kill excel and 
restart every 24 hours 
' 
ArrFile = GetFileList(FilePath + "\" + Filter) 
Select Case IsArray(ArrFile) 
Case True 
For I = LBound(ArrFile) To UBound(ArrFile) 
    F = ArrFile(I) 
    link = (FilePath & "\" & F) 
    IE.Navigate link 
    IE.Visible = True 
    'Application.StatusBar = "Loading " & link 
    Do While IE.Busy 
     Application.Wait DateAdd("s", 2, Now) ' set slide time here 
    Loop 
Next 
Case False 'no files found 
     MsgBox "No matching files" 
End Select 
Next x 
' 
Application.Calculation = xlCalculationAutomatic 
Application.ScreenUpdating = True 
Application.EnableEvents = True 
' 
Set IE = Nothing 
Application.StatusBar = "" 
' 
End Sub