[英]Importing Data from Outlook 2010 into Excel 2010
我在我的網站上有一張表格,當客戶完成該表格后會通過電子郵件發送該表格,如下所示:-
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,那我就迷路了,所以如果可能的話,它必須是白痴格式!
您可以從編寫宏來處理郵件項目開始。 並設置Outlook Rule以從“主題/帳戶”中提取此類電子郵件,然后運行宏。 根據需要更改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
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.