URL 목록을 통해 순환

이 코드는 google, yahoo 등의 URL을 통해 순환 할 때 효과적입니다. 하지만 여기에 표시된대로 웹 페이지를 순환하려고합니다.URL 목록을 통해 순환

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

제 1 회 웹 페이지를 완벽한 열어,하지만 난 얻을 및 자동화 오류, 다음 페이지에 ... 아이디어 순환,이 라인에서 "고객에서 분리 한 호출 된 개체는"대체하는 것입니다 새 탭을 열지 않고 기존 페이지.

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

**** 코드 ***

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

출처

2017-09-07 coves

IE 브라우저에서 수동으로 문제가있는 링크를 열어 보았습니까? 무슨 일이 일어나고 있는지 확인한 다음 –

을 고쳐주세요. 예, 고맙습니다.이 3 개의 웹 페이지는 모두 좋은 페이지입니다. 1, 2, 3 번 슬라이드. 어떻게 든 개체 (웹 페이지라고 생각합니다)는 연결이 끊어 지지만 https 웹 페이지를 사용할 때 그렇지 않습니다. – coves

좋아, 내가 이것으로 가고 있었다 된 엑셀 시트 구절 서버에서 URL 목록을 읽고있다 전략을 변경 다른 이슈들이 분류 된 후에 관리자 계정을 사용하면이 버전이 완벽하게 작동합니다.

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

출처

2017-09-08 19:25:28 coves

URL 목록을 통해 순환

답변

관련 문제