Excel VBA Range.MoveEnd 直到 "," 或 ";"或者 ” ”;以先到者为准？

Question

我正在使用 Excel 宏从 Word 文档中提取电子邮件地址。起初我在文档中找到 @ 符号，后来我移动到包含此 @ 的电子邮件地址的末尾。

在大多数情况下，电子邮件地址以“，”结尾，但由于文档是由许多不同的人创建的，因此有时电子邮件地址以“;”结尾（分号）或只有“”（空格）。

这是我使用的代码：

Dim wordApp As Word.Application
Dim wordDoc As Word.Document        'and it's concatenating them into the destination string variable
Dim excelApp As Excel.Application   'sometimes this code grabs the next line after the last email address, which is the first line of the next patagraph "2. Wszelka korespondencja związana z wykonaniem niniejszej umowy, w tym "
Dim rng As Word.Range
Dim srchRng As Word.Range

With rng.Find
        .Text = "@"                 'we only look for the @ character,
        .Wrap = wdFindStop
        .Forward = True
        .MatchWildcards = False
        .Execute
        'Debug.Print rng.text
        
        Do While .Found             'therefore we need to build whole email addres around this @ character;
            Set srchRng = rng.Duplicate
            srchRng.MoveStartUntil Cset:=" ", Count:=wdBackward      'therefore we need to build whole email addres around this @ character;
            srchRng.MoveEndUntil Cset:=","            'ask the question how to MoveEndUntil "," or ";" or ".";
            Debug.Print srchRng.Text

问题是如何编写代码，以防电子邮件地址后面没有“，”，宏检查是否有“;”和

srchRng.MoveEndUntil Cser:=";"

如果没有“，”或“;”然后宏找到@右侧的第一个空格并朝它移动，

srchRng.MoveEndUntil Cser:=" "

有没有办法把它放到一两行简单的 VBA 行中。

问题是，现在，在当前形式中，电子邮件地址后面总是有一个逗号，所以如果逗号不是直接在电子邮件地址之后，那么宏会捕获电子邮件地址和其他几个词对，这不是我想要的。

我也试过代码：

Dim wordApp As Word.Application
Dim wordDoc As Word.Document        'and it's concatenating them into the destination string variable
Dim excelApp As Excel.Application   'sometimes this code grabs the next line after the last email address, which is the first line of the next patagraph "2. Wszelka korespondencja związana z wykonaniem niniejszej umowy, w tym "
Dim rng As Word.Range
Dim srchRng As Word.Range

With rng.Find
        .Text = "@"                 'we only look for the @ character,
        .Wrap = wdFindStop
        .Forward = True
        .MatchWildcards = False
        .Execute
        'Debug.Print rng.text
        
        Do While .Found             'therefore we need to build whole email addres around this @ character;
            Set srchRng = rng.Duplicate
            srchRng.MoveStartUntil Cset:=" ", Count:=wdBackward      'therefore we need to build whole email addres around this @ character;
            srchRng.MoveEndWhile Cset:=" ,;", Count:=wdForward 
            Debug.Print srchRng.Text

这段代码没有移动任何字符。邮件地址保留为 sekretariat@、spinn2046@ 或 johnnycash@，没有域地址。

如果有什么不同，我会在 excel VBA 编辑器中编写这段代码。

Answer 1

在您开始提取电子邮件之前，将所有分号和空格的出现更改为逗号，以及在您完成关闭文档而不保存之后。

Dim wordApp As Word.Application
Dim wordDoc As Word.Document        'and it's concatenating them into the destination string variable
Dim excelApp As Excel.Application   'sometimes this code grabs the next line after the last email address, which is the first line of the next patagraph "2. Wszelka korespondencja związana z wykonaniem niniejszej umowy, w tym "
Dim rng As Word.Range
Dim srchRng As Word.Range

' Replace All ; to ,
rng.Text = Replace(rng.Text, ";", ",")

' Replace All spaces to ,
' Note: Cset:="," even for the beginning of email now
rng.Text = Replace(rng.Text, " ", ",")

' Similarly replace any other possible character to a comma

With rng.Find
        .Text = "@"                 'we only look for the @ character,
        .Wrap = wdFindStop
        .Forward = True
        .MatchWildcards = False
        .Execute
        'Debug.Print rng.text
        
        Do While .Found             'therefore we need to build whole email addres around this @ character;
            Set srchRng = rng.Duplicate
            srchRng.MoveStartUntil Cset:=",", Count:=wdBackward      'therefore we need to build whole email addres around this @ character;
            srchRng.MoveEndUntil Cset:=","            'ask the question how to MoveEndUntil "," or ";" or ".";
            Debug.Print srchRng.Text

这可能不是最有效的方法，但应该可以完成工作。