Question

我有一个单词文档，其中包含遍布文档的代码和URL。

我一直试图了解如何在此word文档中提取所有网址并将其粘贴到其他文档中？

这些网址都具有以https://subdomain.domain.com开头的同一网站。

问题是..我需要完整的URL链接，通常以.jpg结尾

我试过谷歌搜索，但我找到的解决方案是如何提取超链接的URL。无法找到我的情况的解决方案，所以我希望你们能帮忙！

Answer 1

我编辑了代码以将结果发送到C：\ temp \ my_links.txt。您可以编辑代码以更改目标。

Public Sub GetUrls()
    Dim r As Range
    Dim outfile As String

    outfile = "C:\temp\my_links.txt"
    Open outfile For Output As #1
    Set r = ActiveDocument.Range
    r.Select

    With Selection.Find
        .ClearFormatting
        .Text = "https://subdomain.domain.com/*.jpg"
        .Forward = True
        .Wrap = wdFindStop
        .MatchWildcards = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
    End With

    Do While Selection.Find.Execute
         Write #1, Selection.Text
    Loop

    Close #1
End Sub

当我在测试文件上运行它时，我在输出文件中得到它：

"https://subdomain.domain.com/res1/joe.jpg"
"https://subdomain.domain.com/res2/cat.jpg"

希望有所帮助。

Answer 2

这将解析文档并找到所有网址，并将数组输出到新的Document：

Option Explicit

Sub FindLinks()
  Dim p As Paragraph
  Dim vSplit As Variant
  Dim nIndex As Integer
  Dim sURLs() As String
  ReDim sURLs(0)

  ' find each URL and add it to an array
  For Each p In ActiveDocument.Paragraphs
    vSplit = Split(p.Range, " ")
    For nIndex = 0 To UBound(vSplit)
      If InStr(vSplit(nIndex), "https://stackoverflow.com") > 0 Then
        ReDim Preserve sURLs(UBound(sURLs) + 1)
        sURLs(UBound(sURLs)) = Replace(vSplit(nIndex), "src=", "")
      End If
    Next
  Next

  ' create a new document and output the array
  Dim sURL As Variant
  Documents.Add
  For Each sURL In sURLs
    Selection.TypeText sURL
    Selection.TypeParagraph
  Next

End Sub

如何将Word文档中的URL复制到另一个文档？

2 个答案: