Question

我正在编写一个从网站上抓取船只数据的代码。但是当有多个比赛时，我试图在输入框中显示所有有国家的船只列表。在输入框中，用户将输入他正在搜索的船舶的索引号，他将获得所需的结果。在此代码中，lnk.click正在提供＆＃34;权限被拒绝错误。我无法弄清楚如何解决这个问题，并在每种情况下得到适当的结果。这是我的代码：

Dim ie As Object, ieDoc As Object, lnk As Object, a, nrec, num, fin As String
    Dim j As Variant
    Dim IMO As String, MMSI As String, Flag As String, DWT As String, VType As String, YBuilt As String
    Dim IMOA(0 To 50) As String, MMSIA(0 To 50) As String, FlagA(0 To 50) As String, DWTA(0 To 50) As String, VTypeA(0 To 50) As String, YBuiltA(0 To 50) As String

Sub hull_data_by_Ashish()

For Each cell In Selection
a = UCase(Trim(cell.Value))
Call hullByAshish
ActiveSheet.Cells(cell.Row, 5).Value = VType
ActiveSheet.Cells(cell.Row, 6).Value = IMO
ActiveSheet.Cells(cell.Row, 7).Value = YBuilt
ActiveSheet.Cells(cell.Row, 8).Value = Flag
ActiveSheet.Cells(cell.Row, 9).Value = DWT
'ie.Quit
Next cell
End Sub

Private Sub hullByAshish()
    'Dim IMO As String, MMSI As String, Flag As String, DWT As String, VType As String, YBuilt As String

    Set ie = CreateObject("internetexplorer.application")

    a = "Paragon MSS2"

    With ie
        .Navigate "https://www.marinetraffic.com/en/ais/index/search/all/keyword:" & a
        .Visible = False
    End With

    Do While ie.readyState <> 4: Wait 5: Loop

    DoEvents

    Set ieDoc = ie.document

    For Each lnk In ieDoc.getElementsByTagName("a")
        If lnk.innerHTML = a Then
        nrec = Split(Split(ie.document.body.innerHTML, "Found <strong>")(1), "</strong> records")(0)
        If nrec = 1 Then
            lnk.Click
            Else
            For j = 1 To nrec
            Application.Wait (Now + TimeValue("0:00:03"))
            lnk.Click

            Do While ie.readyState <> 4: Wait 5: Loop
            VTypeA(j) = GetType
            'Application.Wait (Now + TimeValue("0:00:01"))
            IMOA(j) = GetValue("IMO:")
            'MMSI = GetValue("MMSI:")
            YBuiltA(j) = GetValue("Year Built:")
            FlagA(j) = GetValue("Flag:")
            DWTA(j) = GetValue("Deadweight:")
            Next j
            num = "1 - " & IMOA(1) & " - " & FlagA(1)
            For i = 2 To nrec
            num = num & vbCrLf & i & IMOA(i) & " - " & FlagA(i)
            Next i
            fin = InputBox(num, nrec & " - " & " records found for a. please select right one.")
            End If
            Exit For
        End If
    Next lnk

    Do While ie.readyState <> 4: Wait 5: Loop

    Application.Wait (Now + TimeValue("0:00:03"))
    VType = GetType
    'Application.Wait (Now + TimeValue("0:00:01"))
    IMO = GetValue("IMO:")
    'MMSI = GetValue("MMSI:")
    YBuilt = GetValue("Year Built:")
    Flag = GetValue("Flag:")
    DWT = GetValue("Deadweight:")

    'Debug.Print "Vessel Type: " & VType
    'Debug.Print "IMO: " & IMO
    'Debug.Print "MMSI: " & MMSI
    'Debug.Print "Year Built: " & YBuilt
    'Debug.Print "Flag: " & Flag
    'Debug.Print "Deadweight: " & DWT
    ie.Quit
End Sub

Function GetValue(s As String) As String
   'Debug.Print s
   If InStr(ie.document.body.innerHTML, s) <> 0 Then
   GetValue = Trim(Split(Split(Split(Trim(Split(ie.document.body.innerHTML, s)(1)))(0), "<b>")(1), "</b>")(0))
   End If
End Function
Function GetType() As String
   'Debug.Print s
   If InStr(ie.document.body.innerHTML, "Vessel Type: <b") <> 0 Then
   GetType = Replace(Replace(Split(Split(Split(ie.document.body.innerHTML, "Vessel Type: <b")(1), "text-dark")(1), "</b>")(0), """", ""), ">", "")
   End If
End Function

Private Sub Wait(ByVal nSec As Long)
    nSec = nSec + Timer
    While nSec > Timer
        DoEvents
    Wend
End Sub

Link.click给出＆＃34;权限被拒绝＆＃34; VBA中的错误

0 个答案: