String 减少进程时间字符串分解

我希望您能帮助我减少代码的运行时间：

Dim position As Long
Dim CellRow As Long
CellRow = 2

For position = InStr(Inbox.Items(MostRecentVersionIndex).body, "Name") To Len(Inbox.Items(MostRecentVersionIndex).body)
            ThisWorkbook.Sheets(1).Range("A" & CellRow) = Mid(Inbox.Items(MostRecentVersionIndex).body, InStr(position, Inbox.Items(MostRecentVersionIndex).body, "SCA"), InStr(InStr(position, Inbox.Items(MostRecentVersionIndex).body, "SCA") + 1, Inbox.Items(MostRecentVersionIndex).body, "SCA") - InStr(position, Inbox.Items(MostRecentVersionIndex).body, "SCA"))
            CellRow = CellRow + 1
            position = InStr(InStr(position, Inbox.Items(MostRecentVersionIndex).body, "SCA") + 1, Inbox.Items(MostRecentVersionIndex).body, "SCA") - 1
        Next position 

代码的第一部分是在Outlook中查找特定的电子邮件，然后我将其索引存储在

MostRecentVersionIndex

中。（上面未显示）

这封电子邮件的正文中有大量记录（约50万个字符），我代码的第二部分（如上所示）是将每一条记录放在第1页a列的新行中。我知道每个记录都以“SCA”开头，这就是为什么我使用它作为分割参数

问题：运行整个过程大约需要10分钟（毫不奇怪）

有没有办法减少这种情况

编辑：以下是供参考的全部代码（使用解决方案更新后）：

Sub-MailFinder（）
“1）查找Speak先生最近的邮件
将收件箱设置为文件夹
作为整数的Dim i
Dim MostRecentVersionIndex作为整数
MostRecentVersionIndex=-1
Dim TimeReceived As Date
将内容设置为字符串
设置收件箱=会话.GetDefaultFolder（olFolderInbox）
对于i=1到Inbox.Items.Count
如果TypeName（Inbox.Items（i））“ReportItem”则“为避免错误，因为我们无法访问此类文件中的信息”
如果离开（Inbox.Items（i）.Subject，24）=“Mr.speak Subject”然后“Inbox.Items（i）.SenderName=”Mr.speak“然后”
“MsgBox Len（收件箱项目（i）正文）”584512
如果Inbox.Items（i）.ReceivedTime>TimeReceived，则
接收的时间=收件箱中的项目（i）.ReceivedTime
MostRecentVersionIndex=i
如果结束
'ThisWorkbook.Sheets（“Sheet2”）.Range（“A1”）=收件箱.Items（i）.body'仅包含32000个字符
如果结束
如果结束
接下来我
'2）检索其信息并将每一行存储在a列的新行中
暗位置与长位置相同
昏暗的牢房一样长
将RightMail设置为邮件项
设置RightMail=Inbox.Items（MostRecentVersionIndex）
暗体为弦
body=RightMail.body
CellRow=2
如果MostRecentVersionIndex为-1，则
此工作簿。工作表（“辐条主体”）。范围（“A1”）=左侧（主体，仪表（主体，名称）+3）
位置=仪表（主体，“名称”）至透镜（主体）
关于错误转到Fin
此工作簿.Sheets（“SpokeSubject”）.Range（“A”和CellRow）=Mid（主体，仪表（位置，主体，“SCA”）、仪表（仪表（位置，主体，“SCA”）+1，主体，“SCA”）-仪表（位置，主体，“SCA”））
CellRow=CellRow+1
位置=仪表（仪表（位置，阀体，“SCA”）+1，阀体，“SCA”）-1
下一个位置'209333
“收件箱.Items（i）.body.Copy”不起作用
'此工作簿.Sheets（“Sheet2”）.Range（“A1”）.PasteSpecial
'ThisWorkbook.Sheets（“Sheet2”）.Range（“A1”）=收件箱.Items（MostRecentVersionIndex）.body'全部位于一个单元格中。。。
鳍：
如果结束
呼叫格式化程序
端接头

这是一种极端的多点表示法。首先阅读项目，然后阅读其正文，然后循环阅读字符

您需要意识到，每次调用Inbox.Items（MostRecentVersionIndex）.body时，Outlook都会返回Items集合，滚动到索引MostRecentVersionIndex，打开邮件，然后读取其（巨大的）body属性。你这样做5到6次都没有充分的理由

set Item = Inbox.Items(MostRecentVersionIndex)
body = item.Body
For position = InStr(body, "Name") To Len(body)
            ThisWorkbook.Sheets(1).Range("A" & CellRow) = Mid(body, InStr(position, body, "SCA"), InStr(InStr(position, body, "SCA") + 1, body, "SCA") - InStr(position, body, "SCA"))
            CellRow = CellRow + 1
            position = InStr(InStr(position, body, "SCA") + 1, body, "SCA") - 1
        Next position 

---

您是否尝试过使用一些变量来减少每次运行循环时多次解析这些引用所花费的时间？例如，为有问题的邮件项目设置一个变量，或者更好的做法是，将正文文本转换为字符串变量并在其上循环。您可以发布完整的代码吗？@0m3r:好的，我将编辑此帖子。这只会为那些可能感兴趣的人带来价值，尽管因为这与我的问题无关。我感到困惑，我认为我们可以存储在字符串中的字符是有限的，但显然它是有效的。另外，我认为为了提高代码的性能，我们应该使用最少的变量。如果我没有创建

项

变量，而是将整个内容存储在

正文

中，那么性能真的会有所不同吗？在32位中，字符串限制为4Gb。在最好的情况下，最小化变量数量不会起任何作用（编译器仍然必须创建隐式变量来保存中间结果），而在最坏的情况下（如您的情况），会显著降低性能。

set Item = Inbox.Items(MostRecentVersionIndex)
body = item.Body
For position = InStr(body, "Name") To Len(body)
            ThisWorkbook.Sheets(1).Range("A" & CellRow) = Mid(body, InStr(position, body, "SCA"), InStr(InStr(position, body, "SCA") + 1, body, "SCA") - InStr(position, body, "SCA"))
            CellRow = CellRow + 1
            position = InStr(InStr(position, body, "SCA") + 1, body, "SCA") - 1
        Next position