Question

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

You got mail from  Mr Kelley McIntyre.

Here is the form data:
First Name   : Mr XXXXX
Last Name    : XXXXXX
Company Name     : Army
Email Address    : XXXX@hotmail.co.uk
Telephone/Mobile No      : 0123456789
Date of Event    : 14/12/2013
Number of Guests     : 80
Budget   : 6500-7000
Type of Event    : Other
Catering Required    : Yes
Drinks and Entertainment Requirements    : christmas meal, welcome drink, wine at table

British Army Warrant Officers & Sergeants plus wives and partners
How Did You Hear About Us?   : Google

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

有人可以帮忙吗？我知道如何制作一个宏，但如果它的VBA，那么我就输了，所以如果可能的话，它需要采用白痴格式！

Answer 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

将数据从Outlook 2010导入Excel 2010

1 个答案: