Excel 如何使用vba从Word文档中提取电子邮件地址_Excel_Vba_Ms Word

Excel 如何使用vba从Word文档中提取电子邮件地址

excel vba ms-word

Excel 如何使用vba从Word文档中提取电子邮件地址,excel,vba,ms-word,Excel,Vba,Ms Word,我的目标是从Word.ActiveDocument中提取所有电子邮件地址，并将它们放在Excel工作表的一个单元格中代码是从Excel VBA编辑器运行的。它需要搜索电子邮件地址，从文档中提取电子邮件地址并填写Excel单元格Activesheet.Range（“C31”）。无论找到多少个电子邮件地址，只有一个单元格可用找到的地址需要使用“”、“逗号和空格分隔我试图通过在文档中查找@来实现这一点，然后向前和向后建立范围，使所有电子邮件地址都位于范围变量中。使用rng.MoveEndUnti

我的目标是从

Word.ActiveDocument

中提取所有电子邮件地址，并将它们放在Excel工作表的一个单元格中

代码是从Excel VBA编辑器运行的。它需要搜索电子邮件地址，从文档中提取电子邮件地址并填写Excel单元格

Activesheet.Range（“C31”）

。无论找到多少个电子邮件地址，只有一个单元格可用

找到的地址需要使用“

”、“

逗号和空格分隔

我试图通过在文档中查找

来实现这一点，然后向前和向后建立范围，使所有电子邮件地址都位于范围变量中。使用

rng.MoveEndUntil Cset:=“，”

在右侧构建地址非常简单，因为在我的文档中，电子邮件地址后面总是有一个昏迷

但是如何将缺少的电子邮件地址左侧放入范围变量？？我已经使用了

rng.MoveStart Unit:=wdWord，Count:=-1

但是如果电子邮件是romek怎么办。zjelonek@wp.com或者格拉沃。best@yahoo.com这是行不通的

这就是我现在拥有的

Sub FindEmail035()         '[0-9;A-z;,._-]{1;}\@[0-9;A-z;._-]{1;}
                           '[0-9;A-z;,._-]{1;}\@[0-9;A-z;._-]{1;}
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim ExcelApp As Excel.Application

Dim rng As Word.Range
Dim emailAdr As String
Dim ws As Worksheet

Set WordApp = GetObject(, "Word.Application")
Set ExcelApp = GetObject(, "Excel.Application")
Set WordDoc = WordApp.ActiveDocument
Set rng = WordApp.ActiveDocument.Content
Set ws = ExcelApp.ActiveSheet

ExcelApp.Application.Visible = True

    With rng.Find
        .Text = "@"
        .Wrap = wdFindAsk
        .Forward = True
        .MatchWildcards = False
        .Execute

        Debug.Print rng.Text
        If .Found = True Then
            'rng.Expand (wdWord)
            'Debug.Print rng.Text
            rng.MoveStart Unit:=wdWord, Count:=-1
            Debug.Print rng.Text
            rng.MoveEndUntil Cset:=","
            'rng.MoveEnd Unit:=wdWord, Count:=1
            'rng.MoveEndUntil Cset:=" ", Count:=wdBackward
        End If
   End With     'how to create loop that will extract all the email addresses in the document??
   ws.Range("C31").Value = rng

End Sub

我应该使用什么循环来获取文档中存在的邮件数量，然后在文档中建立包含电子邮件地址的范围

这是文档中邮件地址所在的位置

你走在正确的轨道上。这里最简单的方法是使用

.MoveStartUntil Cset:=“Count:=wdBackward

移动范围的开头，这样您就可以向后移动整个范围，直到找到电子邮件地址之前的空格。当然，这是假设格式一致且没有任意空格

我也只需搜索

ActiveDocument.Content

，然后每次

都搜索Set rng
。Found=True

，因为您不希望它覆盖您的范围（搜索范围时就是这样）。或者

Dim

一个新的范围

srchRng

或其他东西，然后将其设置为找到的结果

带rng.Find
.Text=“@”
.Wrap=wdFindAsk
.Forward=True
.MatchWildcards=False
.执行
调试.Print rng.Text
如果.Found=True，则
rng.MoveStartUntil Cset:=“”，Count:=wdBackward
rng.MoveEndUntil Cset:=“，”
如果结束

你走对了方向。这里最简单的方法是使用

.MoveStartUntil Cset:=“Count:=wdBackward