将outlook邮件内的表格部分内容复制不了

将HTMLBody写入剪贴板就行了

SubEmailToExcel()

Setoutlookapp=CreateObject("outlook.application")
Setmyitem=outlookapp.Application.GetNamespace("mapi")
SetMyfolder=myitem.GetDefaultFolder(olFolderInbox).Folders("a")

mailcounts=Myfolder.Items.Count

DimMyDataObjAsNewDataObject
MyDataObj.SetText""

If(MsgBox(mailcounts&"piecesofletterina!",vbYesNo)=vbNo)ThenExitSub

Ifmailcounts>0Then

Fori=1Tomailcounts

IfWorksheets.CountSheets.AddAfter:=Sheets(Sheets.Count)
EndIf

SetTheMail=Myfolder.Items(i)

MyDataObj.SetText(TheMail.HTMLBody)
MyDataObj.PutInClipboard

Sheets(i).Select
Sheets(i).Range("A1").Select
ActiveSheet.Paste

MyDataObj.SetText""

Nexti

EndIf

EndSub