找到從Word到Excel文本後的文本複製

因此，我一直在使用How can I copy one section of text from Word to Excel using an Excel macro?中的代碼將某些找到的文本複製到Word中。但是，我現在需要在找到的字符串之後複製文本中的一定數量的字符。這是迄今爲止代碼：找到從Word到Excel文本後的文本複製

Sub FindAndCopyNext() 

    Dim TextToFind As String, TheContent As String 
    Dim rng As Word.Range 

    TextToFind = "Delivery has failed" 'Not sure if this is best string option 

    Set rng = wdApp.ActiveDocument.Content 
    rng.Find.Execute FindText:=TextToFind, Forward:=True 

    If rng.Find.Found Then 
     'Need to return text (TheContent) that follow the found text 
     LastRow = Range("A" & Rows.Count).End(xlUp).Row + 1 
     Range("A" & LastRow).Value = TheContent 
    Else 
     MsgBox "Text '" & TextToFind & "' was not found!" 
    End If 

End Sub

在Word文檔中的文本始終是這樣的：

'Jibberish Code 
<p><b><font color="#000066" size="3" face="Arial">Delivery has failed to these recipients or groups:</font></b></p> 
<font color="#000000" size="2" face="Tahoma"><p><a href="mailto:[email protected]">[email protected]</a><br> 
'Jibberish Code 
<p><b><font color="#000066" size="3" face="Arial">Delivery has failed to these recipients or groups:</font></b></p> 
<font color="#000000" size="2" face="Tahoma"><p><a href="mailto:[email protected]">[email protected]</a><br> 
'Jibberish Code 
<p><b><font color="#000066" size="3" face="Arial">Delivery has failed to these recipients or groups:</font></b></p> 
<font color="#000000" size="2" face="Tahoma"><p><a href="mailto:[email protected]">[email protected]</a><br>

我需要的只是[email protected]，每個串中發現的時間，將其粘貼到Excel中。

來源

2015-02-05 Chrismas007

如果字符串總是相同的格式[email protected]，指定文檔的字符串變量的全部內容，然後用正則表達式

Sub FindAndCopyNext() 
    Dim wordString As String 
    wordString = wdApp.ActiveDocument.Content ' assign entire content of word document to string 
    Dim rex As New RegExp 
    rex.Pattern = ":(\w+\.\[email protected]\w+\.\w+\.com)" 'Rex pattern with a capturing group for email 
    If rex.Test(wordString) Then 
     Range("A1").Value = rex.Execute(wordString)(0).Submatches(0) 
    End If 
End Sub

編輯：

更新子程序捕獲文檔中的所有電子郵件

Sub FindAndCopyNext() 
    Dim wordString As String 
    wordString = wdApp.ActiveDocument.Content ' assign entire content of word document to string 
    Dim rex As New RegExp 
    rex.Pattern = ":(\w+\.\[email protected]\w+\.\w+\.com)" 'Rex pattern with a capturing group for email 
    rex.Global = True ' multisearch 
    Dim i As Long: i = 1 
    Dim mtch as Object 
    If rex.Test(wordString) Then 
     For Each mtch In rex.Execute(wordString) 
      Range("A" & i).Value = mtch.Submatches(0) 
      i = i + 1 
     Next mtch 
    End If 
End Sub

來源

2015-02-05 17:03:56 Jeanno

我從來沒有使用RegEx搜索，但它似乎只適用於一個電子郵件。我需要它循環瀏覽所有電子郵件並跳到每一行的新行（根據我在Q中的代碼） – Chrismas007 2015-02-05 17:06:11

我已經更新了我的答案以解決您的評論。 – Jeanno 2015-02-05 17:33:28

這可能不是一個精緻的解決方案，但它運行良好，並使用最基本的功能（與RegEx相反，某人可能會建議）。

它使用InStr函數來查找開始標籤和結束標籤，並使用Mid函數獲取它們之間的字符串。

Sub Main() 
    Dim str As String 
    Dim a1 As Integer 
    Dim a2 As Integer 

    str = "<p><b><font color=""#000066"" size=""3"" face=""Arial"">Delivery has failed to these recipients or groups:</font></b></p>" & _ 
      "<font color=""#000000"" size=""2"" face=""Tahoma""><p><a href=""mailto:[email protected]"">[email protected]</a><br>" 

    a1 = InStr(1, str, "<a href=""mailto:") 
    a2 = InStr(a1, str, """>") 

    Debug.Print Mid(str, a1 + Len("<a href=""mailto:"), a2 - a1 - Len("<a href=""mailto:")) 
End Sub

來源

2015-02-05 16:53:44

是的但電子郵件地址是可變的。我需要先找到字符串。只是不知道如何找到它（可能是一個通配符搜索） – Chrismas007 2015-02-05 16:55:20

是的，這將返回字符串的電子郵件地址，你不需要它之前...這就是這是什麼，是不是。 – 2015-02-05 17:08:39

我必須先在Word文檔中找到字符串。然後你的解決方案變得有效 – Chrismas007 2015-02-05 17:09:22

-2

科拉姆1 COLUM 2欄第3 = FIND（「電子郵件：」，A50）= MID（A50，B50 + 6，LEN（A50）-B50 + 1）OUTPUT YOUR EMAIL

這裏A50是與數據電子郵件：[email protected]。列B50是相鄰的單元格

來源

2017-06-22 12:23:41

OP的問題是關於將文本從Word複製到Excel ... – 2017-06-22 13:06:23

找到從Word到Excel文本後的文本複製

回答

相關問題