来自电子邮件循环的VBA数据

有人能完成这个密码吗？我快疯了。 我正在将电子邮件中的数据刮入access。 在这个阶段，我只能勉强将顶线插入通道

我似乎无法让循环数组工作到下一行，以此类推，直到EOF

电子邮件正文如下所示（可能有700行）
（我希望下面的代码能够捕获4行并添加到数据库中。）

代码如下（提前感谢）

选项比较数据库
子邮件（）
Dim olApp作为Outlook.Application
将命名空间设置为Outlook.NameSpace
暗k
Dim j
暗x
Dim xXx
将文件夹设置为Outlook.MAPIFolder
变暗lngCol为长
作为对象
作为字符串计算的Dim
将对象设置为Outlook.NameSpace
作为字符串的文本
作为字符串的Dim BodyRow
Dim数据库作为dao.Database
将rst设置为dao.Recordset
将strData设置为字符串
Set olApp=newoutlook.Application
设置olNamespace=olApp.GetNamespace（“MAPI”）
Set objNS=olApp.GetNamespace（“MAPI”）
设置olFolder=objNS.GetDefaultFolder（olFolderInbox.Folders）（“标记草稿”）
Set rst=CurrentDb.OpenRecordset（“从1=0的电子邮件中选择*”，dbOpenDynaset）
'表称为电子邮件，字段称为emaildata
对于olFolder.Items中的每个msg
Debug.Print msg.Body
BodyTxt=msg.Body
ArrayVariable=拆分（BodyTxt、vbCrLf）
'loop ArrayVariable我不知道您是否只是尝试使用伪代码，因为这不是循环代码

你根本没有增加x

替代品

'loop ArrayVariable    <<< this bit don’t work so it doesn’t drop to the next line

rst.AddNew
rst!EmailData = ArrayVariable(x)
rst.Update

'loop

谢谢米奇，我试试看。我需要在邮件结束时贴上什么东西来说“停止”吗？不-这是UBound做的-在数组中的最后一项停止。很棒的东西我会让你知道我的进展。再次感谢
Option Compare Database

Sub getEmails()

Dim olApp As Outlook.Application
Dim olNamespace As Outlook.NameSpace
Dim k
Dim j
Dim x
Dim xXx
Dim olFolder As Outlook.MAPIFolder
Dim lngCol As Long
Dim olItem As Object
Dim whichAccount As String
Dim objNS As Outlook.NameSpace 
Dim BodyTxt As String
Dim BodyRow As String
Dim db As dao.Database
Dim rst As dao.Recordset
Dim strData As String

Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace("MAPI")
Set objNS = olApp.GetNamespace("MAPI")
Set olFolder = objNS.GetDefaultFolder(olFolderInbox).Folders("MarkDrafts")
Set rst = CurrentDb.OpenRecordset("SELECT * FROM email WHERE 1=0", dbOpenDynaset)

'table is called Email, field is called emaildata
For Each msg In olFolder.Items
Debug.Print msg.Body
BodyTxt = msg.Body

ArrayVariable = Split(BodyTxt, vbCrLf)

'loop ArrayVariable    <<< this bit don’t work so it doesn’t drop to the next line

rst.AddNew
rst!EmailData = ArrayVariable(x)
rst.Update

'loop

Next

rst.Close

Set olApp = Nothing
Set Inbox = Nothing
Set InboxItems = Nothing
Set Mailobject = Nothing
Set TempRst = Nothing

End Sub

'loop ArrayVariable    <<< this bit don’t work so it doesn’t drop to the next line

rst.AddNew
rst!EmailData = ArrayVariable(x)
rst.Update

'loop

For x = lBound(ArrayVariable) to uBound(ArrayVariable)

   rst.AddNew
   rst!EmailData = ArrayVariable(x)
   rst.Update

Next x