[Solved] Need help about word macro

[HansV]

Do the real hyperlinks also end in start=Time1 etc.?

[yanlok1345]

Do the real hyperlinks also end in start=Time1 etc.?

Yes. They are:

https://xxxxxxx.xxxxx.xxx.xx/xxxxxx/xx- ... t=Time%201
https://xxxxxxx.xxxxx.xxx.xx/xxxxxx/xx- ... t=Time%202
https://xxxxxxx.xxxxx.xxx.xx/xxxxxx/xx- ... t=Time%203
https://xxxxxxx.xxxxx.xxx.xx/xxxxxx/xx- ... t=Time%204
https://xxxxxxx.xxxxx.xxx.xx/xxxxxx/xx- ... t=Time%205
https://xxxxxxx.xxxxx.xxx.xx/xxxxxx/xx- ... t=Time%206
https://xxxxxxx.xxxxx.xxx.xx/xxxxxx/xx- ... t=Time%207
https://xxxxxxx.xxxxx.xxx.xx/xxxxxx/xx- ... t=Time%208
https://xxxxxxx.xxxxx.xxx.xx/xxxxxx/xx- ... t=Time%210

These hyperlinks also end in start = Time%201, where "%20" should be equal to "&".

I had asked an expert in VBA, she said:

In the AddLink macro, you can replace each hyperlink as follows:

For i = 1 to SpeechCount
ActiveDocument.Hyperlink(i).Address=Replace(ActiveDocument.Hyperlink(i).Address, “Time ” & i, Sec(i))
Next i

where SpeechCount is the number of speeches in the Excel file and
Sec(i) is the starting time in seconds calculated based on the start time of the speaker Arr(i) in the Excel file.

I don't know if the macro you provided lack of the last one, which is the Sec(i), that's why the macro cannot replace those hyperlinks with calculated seconds.

I need to say sorry again as I have already requested too much. Words are not enough to express my gratitude.

[HansV]

The macro that I wrote does not assume that the hyperlinks in the document are in the same order as the names in the workbook. It searches for the names. If the hyperlinks are in the same order as in the workbook, try this:

Code: Select all

Sub Test()
    Dim EXL As Object
    Dim Wbk As Object
    Dim Wsh As Object
    Dim f As Boolean
    Dim r As Long
    Dim m As Long
    Dim v As String
    Dim t As Long
    Dim a As String
    Dim p As Long
    Dim xlsPath As String

    ' Prompt for Excel file
    xlsPath = BrowseForFile("Please choose an Excel file", True)
    If xlsPath = vbNullString Then
        Beep
        Exit Sub
    End If

    On Error Resume Next
    ' Get Excel if it is already running
    Set EXL = GetObject(Class:="Excel.Application")
    If EXL Is Nothing Then
        ' Otherwise start it
        Set EXL = CreateObject(Class:="Excel.Application")
        f = True
    End If
    On Error GoTo ErrHandler

    ' Open the workbook
    Set Wbk = EXL.Workbooks.Open(xlsPath)
    Set Wsh = EXL.Worksheets(1)
    ' Last used row
    m = Wsh.Range("A" & Wsh.Rows.Count).End(-4162).Row
    ' Loop through the rows
    For r = 2 To m
        ' Get the time
        v = Wsh.Range("B" & r).Value
        t = 3600 * Left(v, 2) + 60 * Mid(v, 3, 2) + Right(v, 2)
        a = ActiveDocument.Hyperlinks(r - 1).Address
        ' Find position of =Time
        p = InStrRev(a, "Time")
        ' New URL
        a = Left(a, p - 1) & t
        ' Update hyperlink address
        ActiveDocument.Hyperlinks(r - 1).Address = a
    Next r

ExitHandler:
    On Error Resume Next
    Wbk.Close SaveChanges:=False
    If f Then
        EXL.Quit
    End If
    Exit Sub

ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

[yanlok1345]

The macro that I wrote does not assume that the hyperlinks in the document are in the same order as the names in the workbook. It searches for the names. If the hyperlinks are in the same order as in the workbook, try this:

Code: Select all

Sub Test()
    Dim EXL As Object
    Dim Wbk As Object
    Dim Wsh As Object
    Dim f As Boolean
    Dim r As Long
    Dim m As Long
    Dim v As String
    Dim t As Long
    Dim a As String
    Dim p As Long
    Dim xlsPath As String

    ' Prompt for Excel file
    xlsPath = BrowseForFile("Please choose an Excel file", True)
    If xlsPath = vbNullString Then
        Beep
        Exit Sub
    End If

    On Error Resume Next
    ' Get Excel if it is already running
    Set EXL = GetObject(Class:="Excel.Application")
    If EXL Is Nothing Then
        ' Otherwise start it
        Set EXL = CreateObject(Class:="Excel.Application")
        f = True
    End If
    On Error GoTo ErrHandler

    ' Open the workbook
    Set Wbk = EXL.Workbooks.Open(xlsPath)
    Set Wsh = EXL.Worksheets(1)
    ' Last used row
    m = Wsh.Range("A" & Wsh.Rows.Count).End(-4162).Row
    ' Loop through the rows
    For r = 2 To m
        ' Get the time
        v = Wsh.Range("B" & r).Value
        t = 3600 * Left(v, 2) + 60 * Mid(v, 3, 2) + Right(v, 2)
        a = ActiveDocument.Hyperlinks(r - 1).Address
        ' Find position of =Time
        p = InStrRev(a, "Time")
        ' New URL
        a = Left(a, p - 1) & t
        ' Update hyperlink address
        ActiveDocument.Hyperlinks(r - 1).Address = a
    Next r

ExitHandler:
    On Error Resume Next
    Wbk.Close SaveChanges:=False
    If f Then
        EXL.Quit
    End If
    Exit Sub

ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

Thanks for your help again.

This time the macro cannot ran and came out "Invalid procedure call or argument (Error 5)".

[HansV]

I have tested this macro too, and it worked correctly with the document and workbook that you provided.
Without seeing the document and workbook in which the code fails, I cannot offer further help. Sorry!

[yanlok1345]

I have tested this macro too, and it worked correctly with the document and workbook that you provided.
Without seeing the document and workbook in which the code fails, I cannot offer further help. Sorry!

I understand that without reviewing the document and workbook where the code fails, it may be difficult for you to offer further assistance. I apologize for any inconvenience caused. I have found another ways to solve the issue.

Thank you once again for your support.