VBAdebugging工作正常,但运行时出错

我最近一直在为自己定制“网站爬虫”来制作一个网站索引/网站地图,自学自己的VBA。

所以我的代码(完成时)将查看并点击网站上的所有链接。

我能够从主页获得所有链接没有问题,并将其放置在Excel中。 但是,当我尝试从其他页面获取链接时,出现运行时错误,如:

“运行时错误'70':权限被拒绝”

要么

“运行时错误'91':对象variables或宽度块未设置”

但是,当我进入debugging模式,并进入代码,我不会遇到任何这些错误。 这很奇怪。

有一点要提到的是,我从一个有很多安全设置(包括互联网限制)的系统访问网站,这就是为什么我有这样一行: CreateObject("new:{D5E8041D-920F-45e9-B8FB-B1DEB82C6E5E}")而不是Create(internetExplorer)等…

它被困在我的代码下面的For Each tabLinks In ieLink2 。 我已经删除了链接,但希望每个人仍然可以得到这个想法..(请注意,我是新的StackOverflow,所以我不知道这是适当的,像这样发布整个代码,或者如果我应该只发布一块我的代码)。

 Public Sub CreateSiteIndex_Click() 'Variables Dim objShell As Object Dim objShellWind As Object Dim ie As Object Dim ieFol As Object Dim ieData As Object Dim ieLink As Object Dim tabData As Object Dim ieLink2 As Object Dim listLinks As Object Dim tabLinks As Object 'Variable for duplicate link check Dim dupCheck As Boolean 'Variables to check for site links Dim siteCheck As Boolean Dim siteAddress As String Dim siteAddress2 As String 'Variables to check for unwanted links Dim noCheck As Boolean Dim noCheckLink As String Dim noCheckLink2 As String 'Track Shell Windows Set objShell = CreateObject("Shell.Application") Set objShellWind = objShell.Windows 'Navigating to webpage Set ie = CreateObject("new:{D5E8041D-920F-45e9-B8FB-B1DEB82C6E5E}") ie.Visible = True ie.Navigate2 "mywebsiteURLisHere(just blocked it out for security purposes" Set ieFol = CreateObject("new:{D5E8041D-920F-45e9-B8FB-B1DEB82C6E5E}") 'Wait until page is loaded before checking links Do Until ie.ReadyState >= 4 DoEvents Loop Application.Wait Now + TimeSerial(0, 0, 5) 'Get all links from webpage and store as a list/array Set ieData = ie.Document 'tabData(0) = 0 Set ieLink = ieData.getElementsByTagName("a") 'These are specifications/filters for which links to allow in the Excel sheet siteAddress = "specific filter here" siteAddress2 = "another one..." noCheckLink = "another filter" 'For Loop - goes through each link on page i = 1 j = 1 k = 1 Cells.Clear For Each listLinks In ieLink 'Checks to make sure no duplicates before adding link to Excel sheet 'dupCheck becomes TRUE if duplicate Range("C1").Select Do Until IsEmpty(ActiveCell) If (ActiveCell = listLinks.href) Then dupCheck = True End If ActiveCell.Offset(1, 0).Select ActiveCell.WrapText = True Loop 'If not a duplicate If (dupCheck = False) Then 'Check that link is a Horizons link sC = InStr(listLinks, siteAddress) sC2 = InStr(listLinks, siteAddress2) 'Check that link is not HOME or TOP OF PAGE nC = InStr(listLinks, noCheckLink) If sC > 0 Or sC2 > 0 Then siteCheck = True End If If nC > 0 Then noCheck = True Else: noCheck = False End If 'If link is a Horizons link AND it not linking back to homepage If (siteCheck = True) Then If (noCheck = False) Then 'Add links to Excel sheet ActiveSheet.Cells(i, 3) = listLinks.href ActiveSheet.Cells(i, 2) = listLinks.innerText 'Convert URL to hyperlink For Each Cell In Selection ActiveSheet.Hyperlinks.Add Cells(i, 3), Cell.Value Next If ieFol Is Nothing Then Set ieFol = CreateObject("new:{D5E8041D-920F-45e9-B8FB-B1DEB82C6E5E}") 'Follow hyperlink 'ActiveSheet.Cells(i, 3).Hyperlinks(1).Follow ieFol.Navigate2 ActiveSheet.Cells(i, 3).Value While ieFol.Busy 'wait for page to load Wend Set tabData = ieFol.Document Set ieLink2 = tabData.getElementsByTagName("a") For Each tabLinks In ieLink2 If ieFol Is Nothing Then Set ieFol = CreateObject("new:{D5E8041D-920F-45e9-B8FB-B1DEB82C6E5E}") If tabData Is Nothing Then Set tabData = ieFol.Document If ieLink2 Is Nothing Then Set ieLink2 = tabData.getElementsByTagName("a") ActiveSheet.Cells(k, 7) = tabLinks.href ActiveSheet.Cells(k, 6) = tabLinks.innerText If ieFol Is Nothing Then Set ieFol = CreateObject("new:{D5E8041D-920F-45e9-B8FB-B1DEB82C6E5E}") If tabData Is Nothing Then Set tabData = ieFol.Document If ieLink2 Is Nothing Then Set ieLink2 = tabData.getElementsByTagName("a") 'Check for broken link If InStr(tabData.Body.innerText, "Page Not Found") > 0 Then 'The link is not valid, flag the cell ActiveSheet.Cells(i, 3).Interior.Color = vbRed End If 'ie.Quit k = k + 1 Next tabLinks 'Next 'Skip link if it links back to homepage ElseIf (noCheck = True) Then i = i - 1 End If siteCheck = False 'If link goes to external site, put it in a different column ElseIf (siteCheck = False) Then ActiveSheet.Cells(j, 5) = listLinks.href ActiveSheet.Cells(j, 4) = listLinks.innerText j = j + 1 i = i - 1 End If 'If it is a duplicate, skip that link Else: dupCheck = False i = i - 1 End If i = i + 1 'On to the next! Next listLinks 'Close the window when done ie.Quit End Sub