Results 1 to 6 of 6
  1. #1
    New Lounger
    Join Date
    Jul 2016
    Posts
    3
    Thanks
    2
    Thanked 0 Times in 0 Posts

    Post VBA Search String Expression...

    I need some help with a macro that has a search string to insert hyperlinks.

    Here's the scenario:

    BM1010 is the active document, and has a list of similar documents to reference:

    BM1010.01.02.03 (macro correctly makes a hyperlink: 010203.pdf)
    BM4010.01.02.D06 (macro correctly makes a hyperlink: ../BM4010/0102D06.pdf)
    BM4010.01.02.C02 (macro correctly makes a hyperlink: ../BM4010/0102C06.pdf)
    BM4010.01.02.H03 (macro correctly makes a hyperlink: ../BM4010/0102H06.pdf)

    BM10010.01.01.05 - a hyperlink is needed for this (using 7 characters for this BM number, but in this case needs the extension “.htm” instead of ".pdf").

    The end result macro hyperlink should be: ../BM10010/010105.htm

    However, if the reference is in its own BM volume "BM10010" then the hyperlink should just be: 010105.htm

    Below is the current macro (see attached Word file):
    Code:
     Sub DocHyperlinks()
     ' Macro to insert Document hyperlinks
     Dim sID As String, r As Range
     Dim SearchString As String, sHL As String
     sID = Left(ActiveDocument.Name, 6)
     Set r = ActiveDocument.Range
     SearchString = "BM[0-9]{4}[A-Z0-9\.]{5,}>"
     With r.Find
     .MatchWildcards = True
     Do While .Execute(FindText:=SearchString, Forward:=True) = True
     sHL = Replace(Mid(r.Text, 7), ".", "") & ".pdf"
     If Left(r.Text, 6) <> sID Then
     sHL = "../" & Left(r.Text, 6) & "/" & sHL
     End If
     ActiveDocument.Hyperlinks.Add Anchor:=r, Address:=sHL, _
     SubAddress:="", ScreenTip:="Click to open document", TextToDisplay:=r.Text
     With r
     .Start = .Hyperlinks(1).Range.End
     .End = ActiveDocument.Range.End
     .Collapse
     End With
     Loop
     End With
     End Sub
    Attached Files Attached Files
    Last edited by RetiredGeek; 2016-07-08 at 13:02. Reason: Added Code Tags

  2. #2
    Super Moderator
    Join Date
    Jan 2001
    Location
    Melbourne, Victoria, Australia
    Posts
    3,852
    Thanks
    4
    Thanked 259 Times in 239 Posts
    Try this. Note that the initial search string was slightly modified to avoid the PDF series also finding the HTM series strings

    Code:
    Sub DocHyperlinks()
      ' Macro to insert Document hyperlinks
      Dim sID As String, r As Range
      Dim SearchString As String, sHL As String
      
      sID = Left(ActiveDocument.Name, 6)
      ''sID = "BM1010"      'for testing purposes only
      Set r = ActiveDocument.Range
      SearchString = "BM[0-9]{4}.[A-Z0-9\.]{4,}>"
      With r.Find
        .MatchWildcards = True
        Do While .Execute(FindText:=SearchString, Forward:=True) = True
          sHL = Replace(Mid(r.Text, 7), ".", "") & ".pdf"
          If Left(r.Text, 6) <> sID Then
            sHL = "../" & Left(r.Text, 6) & "/" & sHL
          End If
          ActiveDocument.Hyperlinks.Add Anchor:=r, Address:=sHL, _
          SubAddress:="", ScreenTip:="Click to open document", TextToDisplay:=r.Text
          With r
            .Start = .Hyperlinks(1).Range.End
            .End = ActiveDocument.Range.End
            .Collapse
          End With
        Loop
      End With
     
      Set r = ActiveDocument.Range
      ''sID = "BM10010"      'for testing purposes only
      SearchString = "BM[0-9]{5}[A-Z0-9\.]{5,}>"
      With r.Find
        .MatchWildcards = True
        Do While .Execute(FindText:=SearchString, Forward:=True) = True
          sHL = Replace(Mid(r.Text, 8), ".", "") & ".htm"
          If Left(r.Text, 7) <> sID Then
            sHL = "../" & Left(r.Text, 7) & "/" & sHL
          End If
          ActiveDocument.Hyperlinks.Add Anchor:=r, Address:=sHL, _
          SubAddress:="", ScreenTip:="Click to open document", TextToDisplay:=r.Text
          With r
            .Start = .Hyperlinks(1).Range.End
            .End = ActiveDocument.Range.End
            .Collapse
          End With
        Loop
      End With
    End Sub
    Andrew Lockton, Chrysalis Design, Melbourne Australia

  3. The Following User Says Thank You to Andrew Lockton For This Useful Post:

    timdata (2016-07-11)

  4. #3
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,054
    Thanks
    2
    Thanked 417 Times in 346 Posts
    Cross-posted at: http://www.vbaexpress.com/forum/show...ing-Expression

    timdata: Please read the Lounge's cross-posting requirements in Rule #14: http://windowssecrets.com/forums/faq...n#crossposting

    VBA Express has similar requirements, with which you also should comply.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  5. The Following User Says Thank You to macropod For This Useful Post:

    timdata (2016-07-11)

  6. #4
    New Lounger
    Join Date
    Jul 2016
    Posts
    3
    Thanks
    2
    Thanked 0 Times in 0 Posts

    Cross-posting

    Sorry, I have just posted a comment on VBA express forum... to request users to redirect to this forum for this posting.

  7. #5
    New Lounger
    Join Date
    Jul 2016
    Posts
    3
    Thanks
    2
    Thanked 0 Times in 0 Posts
    Thanks Andrew... the macro code works in one direction (for example: BM1010 to BM10010), but not the inverse.

    There is a variation that can occur, when the active document is a BM10010.01.02.03 (for example) that needs to have it's own document hyperlink as: 010203.htm - and all other document references have the 6 character document number: "../BMxxxx/010203.pdf".

    We also prefer to have a dialog box that asks the user which is the active BM document volume (such as: BM1010, or BM10010) as a reference point to insert the correct format for the hyperlinks.

    Here's the slightly revised macro, but this only works with 6 characters of the BM number (such as: BM1010), not the 7 character BM number (BM10010).

    Sub DocHyperlinks()
    ' Macro to insert Document hyperlinks
    Dim sID As String, r As Range
    Dim SearchString As String, sHL As String

    sID = InputBox("What is the BM Volume Number for this document? Enter the first 6 or 7 characters of the file name: BMXXXX", "BM Volume Number", "BM")
    If Len(sID) <> 6 Then
    MsgBox "Cancel was selected, No Hyperlinks are inserted in the file", vbCritical + vbOKOnly, "Cancelled"
    Else

    Set r = ActiveDocument.Range
    SearchString = "BM[0-9]{4}.[A-Z0-9\.]{4,}>"
    With r.Find
    .MatchWildcards = True
    Do While .Execute(FindText:=SearchString, Forward:=True) = True
    sHL = Replace(Mid(r.Text, 7), ".", "") & ".pdf"
    If Left(r.Text, 6) <> sID Then
    sHL = "../" & Left(r.Text, 6) & "/" & sHL
    End If
    ActiveDocument.Hyperlinks.Add Anchor:=r, Address:=sHL, _
    SubAddress:="", ScreenTip:="Click to open document", TextToDisplay:=r.Text
    With r
    .Start = .Hyperlinks(1).Range.End
    .End = ActiveDocument.Range.End
    .Collapse
    End With
    Loop
    End With

    sID = Left(ActiveDocument.Name, 7)
    Set r = ActiveDocument.Range
    ''sID = "BM10010" 'for testing purposes only
    SearchString = "BM[0-9]{5}[A-Z0-9\.]{5,}>"
    With r.Find
    .MatchWildcards = True
    Do While .Execute(FindText:=SearchString, Forward:=True) = True
    sHL = Replace(Mid(r.Text, 8), ".", "") & ".htm"
    If Left(r.Text, 7) <> sID Then
    sHL = "../" & Left(r.Text, 7) & "/" & sHL
    End If
    ActiveDocument.Hyperlinks.Add Anchor:=r, Address:=sHL, _
    SubAddress:="", ScreenTip:="Click to open document", TextToDisplay:=r.Text
    With r
    .Start = .Hyperlinks(1).Range.End
    .End = ActiveDocument.Range.End
    .Collapse
    End With
    Loop
    End With
    End If
    End Sub

  8. #6
    Super Moderator
    Join Date
    Jan 2001
    Location
    Melbourne, Victoria, Australia
    Posts
    3,852
    Thanks
    4
    Thanked 259 Times in 239 Posts
    Change the line
    If Len(sID) <> 6 Then

    to
    If Len(sID) < 6 or Len(sID) > 7 or Left(sID,2) <> "BM" Then
    Andrew Lockton, Chrysalis Design, Melbourne Australia

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •