News, tips, advice, support for Windows, Office, PCs & more. Tech help. No bull. We're community supported by donations from our Plus Members, and proud of it
Home icon Home icon Home icon Email icon RSS icon
  • Word 365—Macro to press Enter repeatedly

    Home Forums AskWoody support Productivity software by function MS Word and word processing help Word 365—Macro to press Enter repeatedly

    Tagged: 

    This topic contains 14 replies, has 5 voices, and was last updated by  macropod 6 months, 1 week ago.

    • Author
      Posts
    • #348586 Reply

      Lugh
      AskWoody_MVP

      I need a macro which will press Enter after each paragraph in DOCXs.

      I have hundreds of DOCXs, each containing some web hyperlinks—some over 100 links. I’ve discovered some of the links aren’t ‘live’, ie clickable, so I must fix that. With maybe 5,000 links to check, I need an automated solution.
      Display text isn’t involved, all links are to display as they are, ie ‘http…abc.com/’.
      All links are on their own line, ie in their own paragraph.

      Word automatically creates a live hyperlink when either Enter or Space is pressed after the URL is typed. So my thought is to have a macro press Enter after every paragraph, and then global replace 2 paras with 1 to eliminate the extras. I’ve confirmed that deleting the extras won’t adversely affect the newly created links.

      I’ve tried globally replacing ^p or ^13 with ^p^p or ^13^13, but that doesn’t create a link. Searching says I need…
      Application.SendKeys “{ENTER}”
      …to simulate an Enter press, but I don’t see how to insert that in a global replace macro.

      Help!

      Of course, if you know a better or easier approach, that’s also most welcome 🙂

      Lugh.
      ~
      Alienware Aurora R6; Win10 Home x64 1803; Office 365 x32
      i7-7700; GeForce GTX 1060; 16GB DDR4 2400; 1TB SSD, 256GB SSD, 4TB HD

    • #348597 Reply

      macropod
      AskWoody_MVP

      Try:

      Code:
      Sub UpdateDocuments()
      Application.ScreenUpdating = False
      Dim strFolder As String, strFile As String, strDocNm As String, wdDoc As Document
      strDocNm = ActiveDocument.FullName
      strFolder = GetFolder
      If strFolder = "" Then Exit Sub
      strFile = Dir(strFolder & "\*.doc", vbNormal)
      While strFile <> ""
      If strFolder & "\" & strFile <> strDocNm Then
      Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
      Call MakeLinks(wdDoc)
      wdDoc.Close SaveChanges:=True
      End If
      strFile = Dir()
      Wend
      Set wdDoc = Nothing
      Application.ScreenUpdating = True
      End Sub
      
      Function GetFolder() As String
      Dim oFolder As Object
      GetFolder = ""
      Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
      If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
      Set oFolder = Nothing
      End Function
      
      Sub MakeLinks(wdDoc As Document)
      Application.ScreenUpdating = False
      Dim wdRng As Range
      For Each wdRng In wdDoc.StoryRanges
      With wdRng
      With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Format = False
      .Wrap = wdFindStop
      .MatchWildcards = True
      .Replacement.Text = ""
      ' hyperlinks
      .Text = "htt[ps]{1,2}://[!^13^t^l ]{1,}"
      .Execute
      End With
      Do While .Find.Found
      .Hyperlinks.Add .Duplicate, .Text, , , .Text
      .Start = .Hyperlinks(1).Range.End
      .Find.Execute
      Loop
      End With
      With wdRng
      With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Format = False
      .Wrap = wdFindStop
      .MatchWildcards = True
      .Replacement.Text = ""
      ' email addresses
      .Text = "<[0-9A-ÿ.\-]{1,}\@[0-9A-ÿ\-.]{1,}"
      .Execute
      End With
      Do While .Find.Found
      .Hyperlinks.Add .Duplicate, "mailto:" & .Text, , , .Text
      .Start = .Hyperlinks(1).Range.End
      .Find.Execute
      Loop
      End With
      Next
      Application.ScreenUpdating = True
      End Sub

      Cheers,
      Paul Edstein
      [Fmr MS MVP - Word]

      2 users thanked author for this post.
      • #348632 Reply

        Lugh
        AskWoody_MVP

        Try: … Cheers,
        Paul Edstein

        Cheers, indeed. I sincerely hope most of that was copy/paste Paul, phenomenal effort, hugely appreciated.

        And that’s before I wander off and test it!

        Great to see you made the transition here btw 🙂

        Lugh.
        ~
        Alienware Aurora R6; Win10 Home x64 1803; Office 365 x32
        i7-7700; GeForce GTX 1060; 16GB DDR4 2400; 1TB SSD, 256GB SSD, 4TB HD

    • #348619 Reply

      Paul T
      AskWoody MVP

      Paul, you can post code using the <pre></pre> tags.

      1. Write your blurb in the reply field.
      2. Edit your code in an editor – Notepad++ etc.
      3. Add the pre tags to the code.
      4. Return to the post editor and select the Text tab.
      5. Paste your code with tags.
      6. Select the Visual tab to view the post.
      Sub UpdateDocuments()
      	Application.ScreenUpdating = False
      	Dim strFolder As String, strFile As String, strDocNm As String, wdDoc As Document
      strDocNm = ActiveDocument.FullName

      cheers, Paul

      2 users thanked author for this post.
    • #348650 Reply

      Lugh
      AskWoody_MVP

      strFile = Dir(strFolder & “*.doc”, vbNormal)

      Paul, I get a Compile error Syntax error popup dialog with above line highlighted.

      Also looking suspect [showing in red in VBA editor] are following:

      Set oFolder = CreateObject(“Shell.Application”).BrowseForFolder(0, “Choose a folder”, 0)

      .Text = “htt[ps]{1,2}://[!^13^t^l ]{1,}”

      ‘ email addresses
      .Text = “<[0-9A-ÿ.-]{1,}@[0-9A-ÿ-.]{1,}”

      .Hyperlinks.Add .Duplicate, “mailto:” & .Text, , , .Text

      Sample extract image:
      WordMacroLinks

      Lugh.
      ~
      Alienware Aurora R6; Win10 Home x64 1803; Office 365 x32
      i7-7700; GeForce GTX 1060; 16GB DDR4 2400; 1TB SSD, 256GB SSD, 4TB HD

      Attachments:
    • #348948 Reply

      macropod
      AskWoody_MVP

      For some reason, the software here changed all the straight quotes in my code to smart quotes – which broke the code. Trying again with the ‘pre’ tags:

      Sub UpdateDocuments()
      Application.ScreenUpdating = False
      Dim strFolder As String, strFile As String, strDocNm As String, wdDoc As Document
      strDocNm = ActiveDocument.FullName
      strFolder = GetFolder
      If strFolder = "" Then Exit Sub
      strFile = Dir(strFolder & "\*.doc", vbNormal)
      While strFile <> ""
      If strFolder & "\" & strFile <> strDocNm Then
      Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
      Call MakeLinks(wdDoc)
      wdDoc.Close SaveChanges:=True
      End If
      strFile = Dir()
      Wend
      Set wdDoc = Nothing
      Application.ScreenUpdating = True
      End Sub
      
      Function GetFolder() As String
      Dim oFolder As Object
      GetFolder = ""
      Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
      If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
      Set oFolder = Nothing
      End Function
      
      Sub MakeLinks(wdDoc As Document)
      Dim wdRng As Range
      For Each wdRng In wdDoc.StoryRanges
      With wdRng
      With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Format = False
      .Wrap = wdFindStop
      .MatchWildcards = True
      .Replacement.Text = ""
      ' hyperlinks
      .Text = "htt[ps]{1,2}://[!^13^t^l ]{1,}"
      .Execute
      End With
      Do While .Find.Found
      .Hyperlinks.Add .Duplicate, .Text, , , .Text
      .Start = .Hyperlinks(1).Range.End
      .Find.Execute
      Loop
      End With
      With wdRng
      With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Format = False
      .Wrap = wdFindStop
      .MatchWildcards = True
      .Replacement.Text = ""
      ' email addresses
      .Text = "<[0-9A-?.\-]{1,}\@[0-9A-?\-.]{1,}"
      .Execute
      End With
      Do While .Find.Found
      .Hyperlinks.Add .Duplicate, "mailto:" & .Text, , , .Text
      .Start = .Hyperlinks(1).Range.End
      .Find.Execute
      Loop
      End With
      Next
      End Sub<span style="display: inline !important; float: none; background-color: transparent; color: #333333; font-family: Georgia,'Times New Roman','Bitstream Charter',Times,serif; font-size: 16px; font-style: normal; font-variant: normal; font-weight: 400; letter-spacing: normal; line-height: 24px; orphans: 2; text-align: left; text-decoration: none; text-indent: 0px; text-transform: none; -webkit-text-stroke-width: 0px; white-space: normal; word-spacing: 0px; word-wrap: break-word;">

      </span>

      Cheers,
      Paul Edstein
      [Fmr MS MVP - Word]

      2 users thanked author for this post.
    • #349030 Reply

      Lugh
      AskWoody_MVP

      Thanks again, Paul.

      Above stopped working after the folder selection dialog. I tried stepping thru the code, and changed this line…

      strFile = Dir(strFolder & “\*.doc”, vbNormal)

      from *.doc to *.docx, since my test folder has only DOCXs.

      That got further, and produced an error message:
      Run-time error ‘5590’:
      The Find What text contains a range that is not valid.

      Clicking Debug highlighted a .Execute line in the MakeLinks sub in the ’email addresses’ section, ie the middle line here:

      .Text = “<[0-9A-?.\-]{1,}\@[0-9A-?\-.]{1,}”
      .Execute
      End With

      I’m not comfy enough with regex to guess what might be amiss there.

      Lugh.
      ~
      Alienware Aurora R6; Win10 Home x64 1803; Office 365 x32
      i7-7700; GeForce GTX 1060; 16GB DDR4 2400; 1TB SSD, 256GB SSD, 4TB HD

      • #349052 Reply

        mn–
        AskWoody Lounger

        .Text = “<[0-9A-?.\-]{1,}\@[0-9A-?\-.]{1,}”
        .Execute
        End With

        I’m not comfy enough with regex to guess what might be amiss there.

        At least a character set conversion failure somewhere along the way, possibly more than one in a sequence.

        Because the original post had an ÿ in there and that’s gotten replaced by a question mark.

        Try:

        Code:
        ...
        ‘ email addresses
        .Text = “<[0-9A-ÿ.\-]{1,}\@[0-9A-ÿ\-.]{1,}”
        .Execute
        End With
        ...

        … let’s see if it gets mangled again… I’m on the tag-editing side, one of the y+umlaut is a literal and another is a character entity…

        Then, unless this engine has some really weird character selection ranges, that regex will fail to catch a number of perfectly good email addresses, and also will catch things that aren’t valid addresses. Also a literal ÿ is not allowed AFAICT until RFC6532… one thing that’s nasty with locale support is that character collation orders are locale-dependent, and thus character ranges will occasionally differ based on what locale you’re running in.

        Then again regex and email addressing don’t really mix.
        (See https://stackoverflow.com/questions/201323/how-to-validate-an-email-address-using-a-regular-expression … also note that in the old days you could find also UUCP and X.400 paths in email addresses, among other things. And then there was the source-routed “percent hack” SMTP option, which I actually last used not all that many years ago…)

        So. Going by the original scope of the question… do you desire that email addresses be handled also, or should the code just skip those altogether?

        1 user thanked author for this post.
    • #349059 Reply

      macropod
      AskWoody_MVP

      Above stopped working after the folder selection dialog. I tried stepping thru the code, and changed this line…

      strFile = Dir(strFolder & “\*.doc”, vbNormal)

      from *.doc to *.docx, since my test folder has only DOCXs.

      As written the original code would process .doc, .docx, and .docm files. As such mailmerge main documents and some documents with macros could interfere with the operation. Changing to .docx will cure the macro issues.

      That got further, and produced an error message:
      Run-time error ‘5590’:
      The Find What text contains a range that is not valid.

      Clicking Debug highlighted a .Execute line in the MakeLinks sub in the ’email addresses’ section, ie the middle line here:

      .Text = “<[0-9A-?.\-]{1,}\@[0-9A-?\-.]{1,}”

      Again, this site’s software has mangled the code. The two ? characters should be ÿ.

      As for mn_’s commentary, the code isn’t using regex…

      Cheers,
      Paul Edstein
      [Fmr MS MVP - Word]

      2 users thanked author for this post.
      • #349127 Reply

        Lugh
        AskWoody_MVP

        Paul, I am in awe. Just ran in a folder of 165 files and it did them all in under a minute. Phenomenal, saves me weeks of drudgery, and of course much more consistent quality too. Thank you again, very much appreciated.

        Changing to .docx will cure the macro issues

        All the files I need to work on for now are DOCX, so I’ll leave it at that.

        The two ? characters should be ÿ.

        Yep, that fixed it.

        the code isn’t using regex

        Oh, it looks very regexy—is it part of VBA wildcards special ‘stuff’?

        Lugh.
        ~
        Alienware Aurora R6; Win10 Home x64 1803; Office 365 x32
        i7-7700; GeForce GTX 1060; 16GB DDR4 2400; 1TB SSD, 256GB SSD, 4TB HD

    • #349122 Reply

      Lugh
      AskWoody_MVP

      Thanks for your time & effort mn—, appreciated 🙂

      do you desire that email addresses be handled also, or should the code just skip those altogether?

      99% of the links are http, might be 50 mailto in there and they’re less important. So email can be skipped if it’s the diff between the code running and not.

      Now, off to test again—I assume the y-umlaut character is Alt 152, ie ÿ.

      Lugh.
      ~
      Alienware Aurora R6; Win10 Home x64 1803; Office 365 x32
      i7-7700; GeForce GTX 1060; 16GB DDR4 2400; 1TB SSD, 256GB SSD, 4TB HD

    • #349432 Reply

      macropod
      AskWoody_MVP

      Indeed, they’re Word wildcards – which are akin to RegEx. For more on wildcards, see: https://wordmvp.com/FAQs/General/UsingWildcards.htm

      Cheers,
      Paul Edstein
      [Fmr MS MVP - Word]

      1 user thanked author for this post.
    • #350864 Reply

      Andrew Lockton
      AskWoody_MVP

      For completeness, there is an autoformat option to find text strings and turn them into hyperlinks which could have simplified the MakeLinks function

        With Options
          .AutoFormatApplyHeadings = False
          .AutoFormatApplyLists = False
          .AutoFormatApplyBulletedLists = False
          .AutoFormatApplyOtherParas = False
          .AutoFormatReplaceQuotes = False
          .AutoFormatReplaceSymbols = False
          .AutoFormatReplaceOrdinals = False
          .AutoFormatReplaceFractions = False
          .AutoFormatReplacePlainTextEmphasis = False
          .AutoFormatReplaceHyperlinks = True
          .AutoFormatPreserveStyles = True
          .AutoFormatPlainTextWordMail = True
          .LabelSmartTags = False
        End With
        Selection.Range.AutoFormat
      2 users thanked author for this post.
    • #350882 Reply

      Lugh
      AskWoody_MVP

      Thanks Andrew. Should your code replace all of Paul’s…
      Sub MakeLinks(wdDoc As Document)
      …or just part of it?

      Lugh.
      ~
      Alienware Aurora R6; Win10 Home x64 1803; Office 365 x32
      i7-7700; GeForce GTX 1060; 16GB DDR4 2400; 1TB SSD, 256GB SSD, 4TB HD

    • #360035 Reply

      macropod
      AskWoody_MVP

      You could, but you need to consider restoring those options to their previous state, too. Rather than modifying the MakeLinks Sub, there’s a better way if you want to go down that path:

      Sub UpdateDocuments()
      Application.ScreenUpdating = False
      Dim strFolder As String, strFile As String, strDocNm As String, wdDoc As Document
      Dim bHead As Boolean, bList As Boolean, bBullet As Boolean, _
        bOther As Boolean, bQuote As Boolean, bSymbol As Boolean, _
        bOrdinal As Boolean, bFraction As Boolean, bEmphasis As Boolean, _
        bHLink As Boolean, bStyle As Boolean, bMail As Boolean, bTag As Boolean
      strDocNm = ActiveDocument.FullName
      strFolder = GetFolder
      If strFolder = "" Then Exit Sub
      With Options
        bHead = .AutoFormatApplyHeadings
        bList = .AutoFormatApplyLists
        bBullet = .AutoFormatApplyBulletedLists
        bOther = .AutoFormatApplyOtherParas
        bQuote = .AutoFormatReplaceQuotes
        bSymbol = .AutoFormatReplaceSymbols
        bOrdinal = .AutoFormatReplaceOrdinals
        bFraction = .AutoFormatReplaceFractions
        bEmphasis = .AutoFormatReplacePlainTextEmphasis
        bHLink = .AutoFormatReplaceHyperlinks
        bStyle = .AutoFormatPreserveStyles
        bMail = .AutoFormatPlainTextWordMail
        bTag = .LabelSmartTags
      End With
      With Options
        .AutoFormatApplyHeadings = False
        .AutoFormatApplyLists = False
        .AutoFormatApplyBulletedLists = False
        .AutoFormatApplyOtherParas = False
        .AutoFormatReplaceQuotes = False
        .AutoFormatReplaceSymbols = False
        .AutoFormatReplaceOrdinals = False
        .AutoFormatReplaceFractions = False
        .AutoFormatReplacePlainTextEmphasis = False
        .AutoFormatReplaceHyperlinks = True
        .AutoFormatPreserveStyles = True
        .AutoFormatPlainTextWordMail = True
        .LabelSmartTags = False
      End With
      strFile = Dir(strFolder & "\*.doc", vbNormal)
      While strFile <> ""
      If strFolder & "\" & strFile <> strDocNm Then
        Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
        With wdDoc
          .Range.AutoFormat
          .Close SaveChanges:=True
        End With
      End If
      strFile = Dir()
      Wend
      Set wdDoc = Nothing
      With Options
        .AutoFormatApplyHeadings = bHead
        .AutoFormatApplyLists = bList
        .AutoFormatApplyBulletedLists = bBullet
        .AutoFormatApplyOtherParas = bOther
        .AutoFormatReplaceQuotes = bQuote
        .AutoFormatReplaceSymbols = bSymbol
        .AutoFormatReplaceOrdinals = bOrdinal
        .AutoFormatReplaceFractions = bFraction
        .AutoFormatReplacePlainTextEmphasis = bEmphasis
        .AutoFormatReplaceHyperlinks = bHLink
        .AutoFormatPreserveStyles = bStyle
        .AutoFormatPlainTextWordMail = bMail
        .LabelSmartTags = bTag
      End With
      Application.ScreenUpdating = True
      End Sub
      
      Function GetFolder() As String
      Dim oFolder As Object
      GetFolder = ""
      Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
      If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
      Set oFolder = Nothing
      End Function

      Cheers,
      Paul Edstein
      [Fmr MS MVP - Word]

      1 user thanked author for this post.

    Please follow the -Lounge Rules- no personal attacks, no swearing, and politics/religion are relegated to the Rants forum.

    Reply To: Word 365—Macro to press Enter repeatedly

    You can use BBCodes to format your content.
    Your account can't use Advanced BBCodes, they will be stripped before saving.