Hyperlinks are not added in run mode but they are in debug mode

  Kiến thức lập trình

I’m running Excel version 2408. The following code populates two tables using a query connection and then adds some hyperlinks. The hyperlinks are added correctly for the first table (tblNoStop) but not for the second (tblNoOffice).

If I put a break before the loop that populates the hyperlinks for the second table and then hit F5 from the debugger, everything works fine.

I have tried adding the DoEvents instruction and forced a wait time of up to one minute, but no success.

I also tried commenting out the first loop, but the result is the same: hyperlinks in table tblNoOffice are only added in debug mode.

Does anybody have an idea?

Here is the relevant part of my code:

'For each liine of the tables update hyperlinks
For RowCounter = 1 To tblNoStop.ListRows.Count
    
    'Add link to the staff  details in the ADAM web application
    Set HLRange = tblNoStop.DataBodyRange(RowCounter, NOSTOP_INDEXCOLIND)
    Call AddHL(HLRange, _
        wsNoStop, _
        "https://adam.unctad.unctad.org/StaffDetails.aspx?id=" & tblNoStop.DataBodyRange(RowCounter, NOSTOP_INDEXCOLIND).Value & "&activemenu=1", _
        "", _
        SCRTIP & tblNoStop.DataBodyRange(RowCounter, NOSTOP_FIRSTNAMECOLIND).Text & " " & tblNoStop.DataBodyRange(RowCounter, NOSTOP_LASTNAMECOLIND) & ADAMWEB)

    'Add link to the staff requests' list in the ADAM web application
    Set HLRange = tblNoStop.DataBodyRange(RowCounter, NOSTOP_STOPACCCOLIND)
    Call AddHL(HLRange, _
        wsNoStop, _
        "https://adam.unctad.unctad.org/RequestList.aspx?id=" & tblNoStop.DataBodyRange(RowCounter, NOSTOP_INDEXCOLIND).Value & "&activemenu=1", _
        "", _
        SCRTIP & tblNoStop.DataBodyRange(RowCounter, NOSTOP_FIRSTNAMECOLIND).Text & " " & tblNoStop.DataBodyRange(RowCounter, NOSTOP_LASTNAMECOLIND) & ADAMREQ)
    
    'Add link to the staff's equipment assignment history
    Set HLRange = tblNoStop.DataBodyRange(RowCounter, NOSTOP_FIRSTNAMECOLIND)
    Call AddHL(HLRange, _
        wsNoStop, _
        "https://adam.unctad.unctad.org/itinventory/EquipmentAssignment.aspx?id=" & tblNoStop.DataBodyRange(RowCounter, NOSTOP_INDEXCOLIND).Value & "&type=2&search=h", _
        "", _
        SCRTIP & tblNoStop.DataBodyRange(RowCounter, NOSTOP_FIRSTNAMECOLIND).Text & " " & tblNoStop.DataBodyRange(RowCounter, NOSTOP_LASTNAMECOLIND) & ADAMASS)
Next

Set tblNoOffice = wsNoStop.ListObjects("NoOffice")
wsNoStop.Activate
DoEvents
'Application.Wait (Now + TimeValue("00:01:05"))

For RowCounter = 1 To tblNoOffice.ListRows.Count

    'Add link to the staff  details in the ADAM web application
    Set HLRange = tblNoOffice.DataBodyRange(RowCounter, NOOFFICE_INDEXCOLIND)
    Call AddHL(HLRange, _
        wsNoStop, _
        "https://adam.unctad.unctad.org/StaffDetails.aspx?id=" & tblNoOffice.DataBodyRange(RowCounter, NOOFFICE_INDEXCOLIND).Value & "&activemenu=1", _
        "", _
        SCRTIP & tblNoOffice.DataBodyRange(RowCounter, NOOFFICE_FIRSTNAMECOLIND).Text & " " & tblNoOffice.DataBodyRange(RowCounter, NOOFFICE_LASTNAMECOLIND) & ADAMWEB)
        DoEvents
    
    'Add link to the staff requests' list in the ADAM web application
    Set HLRange = tblNoOffice.DataBodyRange(RowCounter, NOOFFICE_ADACCEXPCOLIND)
    Call AddHL(HLRange, _
        wsNoStop, _
        "https://adam.unctad.unctad.org/RequestList.aspx?id=" & tblNoOffice.DataBodyRange(RowCounter, NOOFFICE_INDEXCOLIND).Value & "&activemenu=1", _
        "", _
        SCRTIP & tblNoOffice.DataBodyRange(RowCounter, NOOFFICE_FIRSTNAMECOLIND).Text & " " & tblNoOffice.DataBodyRange(RowCounter, NOOFFICE_LASTNAMECOLIND) & ADAMREQ)


    'Add link to the staff's equipment assignment history
    Set HLRange = tblNoOffice.DataBodyRange(RowCounter, NOOFFICE_FIRSTNAMECOLIND)
    Call AddHL(HLRange, _
        wsNoStop, _
        "https://adam.unctad.unctad.org/itinventory/EquipmentAssignment.aspx?id=" & tblNoOffice.DataBodyRange(RowCounter, NOOFFICE_INDEXCOLIND).Value & "&type=2&search=h", _
        "", _
        SCRTIP & tblNoOffice.DataBodyRange(RowCounter, NOOFFICE_FIRSTNAMECOLIND).Text & " " & tblNoOffice.DataBodyRange(RowCounter, NOOFFICE_LASTNAMECOLIND) & ADAMASS)
Next

Sub AddHL(HLRng As Range, Tgtws As Worksheet, tgtAddr As String, SubAddr As String, SCRTIP As String, Optional DispTxt As Variant)
'Colours list can be found at  http://dmcritchie.mvps.org/excel/colors.htm

On Error GoTo ErrHandler

If IsMissing(DispTxt) Then
    
    Tgtws.Hyperlinks.Add _
    Anchor:=HLRng, _
    Address:=tgtAddr, _
    SubAddress:=SubAddr, _
    ScreenTip:=SCRTIP, _
    TextToDisplay:=HLRng.Text
Else
    Tgtws.Hyperlinks.Add _
    Anchor:=HLRng, _
    Address:=tgtAddr, _
    SubAddress:=SubAddr, _
    ScreenTip:=SCRTIP, _
    TextToDisplay:=DispTxt
End If
Exit Sub
ErrHandler:
    If Err.Number <> 0 Then
    MsgBox "Error #" & Str(Err.Number) & " was generated by " _
         & Err.Source & Chr(13) & "Error Line: " & Erl & Chr(13) & Err.Description, , "Error in subroutine AddHL (Module1)" & _
         "", Err.HelpFile, Err.HelpContext
    End If
End Sub

9

Thanks to the comment made by @CHill60, I added the line

ThisWorkbook.Connections("Query - NoOffice").OLEDBConnection.BackgroundQuery = False

and the problem disappeared.

Theme wordpress giá rẻ Theme wordpress giá rẻ Thiết kế website Kho Theme wordpress Kho Theme WP Theme WP

LEAVE A COMMENT