将HTMLBody写入剪贴板就行了
Sub EmailToExcel()
Set outlookapp = CreateObject("outlook.application")
Set myitem = outlookapp.Application.GetNamespace("mapi")
Set Myfolder = myitem.GetDefaultFolder(olFolderInbox).Folders("a")
mailcounts = Myfolder.Items.Count
Dim MyDataObj As New DataObject
MyDataObj.SetText ""
If (MsgBox(mailcounts & " pieces of letter in a!", vbYesNo) = vbNo) Then Exit Sub
If mailcounts > 0 Then
For i = 1 To mailcounts
If Worksheets.Count < mailcounts Then
Sheets.Add After:=Sheets(Sheets.Count)
End If
Set TheMail = Myfolder.Items(i)
MyDataObj.SetText (TheMail.HTMLBody)
MyDataObj.PutInClipboard
Sheets(i).Select
Sheets(i).Range("A1").Select
ActiveSheet.Paste
MyDataObj.SetText ""
Next i
End If
End Sub
打开邮箱,把你要的表格附件下载下来,或者是选中表格复制下来。试试吧。