将数据从 Outlook 2010 导入 Excel 2010答案

【问题标题】：Importing Data from Outlook 2010 into Excel 2010将数据从 Outlook 2010 导入 Excel 2010
【发布时间】：2013-09-06 14:07:05
【问题描述】：

我的网站上有表格，当客户完成时会通过电子邮件发送，然后看起来像这样：-

您收到了来自 Kelley McIntyre 先生的邮件。

这是表单数据：
姓名：XXXXX先生
姓氏：XXXXXX
公司名称：陆军
电子邮件地址：XXXX@hotmail.co.uk
电话/手机号码：0123456789
活动日期：14/12/2013
宾客人数 : 80
预算：6500-7000
活动类型 : 其他
是否需要餐饮：是
饮品和娱乐要求：圣诞大餐、迎宾饮品、餐桌上的葡萄酒

英国陆军准尉和中士以及妻子和伴侣
你是怎么知道我们的？ : 谷歌

您可以看到它相当简单的形式，但是每次我收到其中一封电子邮件时，我都需要将这些数据导出到 Excel 中，这样我就可以记录我们收到的所有查询。

有人可以帮忙吗？我知道如何做一个宏，但如果它是 VBA，那我就迷路了，所以如果可能的话，它需要是白痴格式！

【问题讨论】：

Rossy，在你提出问题之前，你需要表现出一些努力 :) 否则我怀疑你会得到任何帮助......
如果我知道从哪里开始，我会的！
也许是一本不错的 VBA 书籍或在线 VBA 教程？

标签： vba email excel outlook

【解决方案1】：

您可以从编写宏来处理邮件项目开始。并设置 Outlook 规则以从主题/帐户中提取此类电子邮件，然后运行宏。根据需要更改 sExcelFile、sRecordSheet、iC。我做了假设。

以下代码适用于 Outlook，请注意，您需要始终运行 Outlook 才能实现此自动化。它应该让你半途而废。请注意，您的参考文献中需要“Microsoft Excel x.0 对象库”。

Public Sub Rules_WebSiteFormRecord(oMail As MailItem)

    Const sExcelFile As String = "C:\Test\Record.xlsx"
    Const sRecordSheet As String = "Record" ' Worksheet name

    Dim oExcel As Excel.Application, oWB As Excel.Workbook, oWS As Excel.worksheet
    Dim arrTxt As Variant, oLine As Variant, iR As Long, iC As Long, bWrite As Boolean

    Set oExcel = CreateObject("excel.application")
    Set oWB = oExcel.Workbooks.Open(FileName:=sExcelFile)
    Set oWS = oWB.Worksheets(sRecordSheet)
    ' Make Excel visible for Debug purpose:
    oExcel.Visible = True
    ' Find next row of Last used row in Excel worksheet
    iR = oWS.Cells(Rows.Count, 1).End(xlUp).Row + 1
    ' Process email body and store it into columns of worksheet "sRecordSheet"
    'Debug.Print oMail.Body
    ' Store received time of email in Column A
    oWS.Cells(iR, 1).Value = oMail.ReceivedTime
    ' Split the email body into lines then process each
    arrTxt = Split(oMail.Body, vbCrLf)
    For Each oLine In arrTxt
        bWrite = False
        ' store data according to text in line
        If InStr(1, oLine, "First Name", vbTextCompare) Then
            iC = 2 ' Column of First Name
            bWrite = True
        ElseIf InStr(1, oLine, "Last Name", vbTextCompare) Then
            iC = 3 ' Column of First Name
            bWrite = True
            ' Add the rest of the fields...
        End If
        If bWrite Then
            oWS.Cells(iR, iC).Value = Split(oLine, ":")(1)
            iR = iR + 1
        End If
    Next
    Set oWS = Nothing
    ' Close the workbook with saving changes
    oWB.Close True
    Set oWB = Nothing
    Set oExcel = Nothing
    ' mark it as Read if no error occurred
    If Err.Number = 0 Then
        oMail.UnRead = False
    Else
        MsgBox "ERR(" & Err.Number & ":" & Err.Description & ") while processing " & oMail.Subject
        Err.Clear
    End If
End Sub

【讨论】：