vba复制电子邮件正文为表格

嗨，我有以下代码成功循环通过我的文件夹，并拉我想要的电子邮件，并复制到Excel中的正文（表格格式）。 然而，当我粘贴它时，整个身体将被粘贴在单元格A1，当它应该填充范围A1：K92，就像我手动复制和粘贴它。 有没有什么办法可以使用vba将其粘贴到正确的范围内？ 谢谢！

Sub GetFXEmail() Dim olApp As Outlook.Application Dim olNs As Namespace Dim Fldr As MAPIFolder Dim olMi As Variant Dim i As Integer Set olApp = New Outlook.Application Set olNs = olApp.GetNamespace("MAPI") Set Fldr = olNs.GetDefaultFolder(olFolderInbox) Set Fldr = Fldr.Folders("MyFolder") Set inboxItems = Fldr.Items pnldate = Format((Date - 1), "mm/dd/yyyy") Set inboxItems = Fldr.Items inboxItems.Sort "[ReceivedTime]", True For i = 1 To Fldr.Items.Count Step 1 Set olMi = Fldr.Items(i) If Format(olMi.ReceivedTime, "mm/dd/yyyy") = pnldate Then Debug.Print olMi.ReceivedTime Debug.Print olMi.Subject If InStr(1, olMi.Subject, "Breakdown") > 0 Then Sheets("Sheet1").Range("A1") = olMi.Body GoTo AllDone End If End If Next i AllDone: End Sub 

Answer 1

如果电子邮件中只有一个表格，并将其识别为实际表格，则此代码（将放置在第一个If块中）将可以工作（并已经过testing） 。 如果需要，您可以修改部件以适合您的确切需求。

另请注意，它需要Microsoft Word对象库的引用（因为您已经拥有Outlook对象库）。

 If Format(olMi.ReceivedTime, "mm/dd/yyyy") = pnldate Then With olMi Debug.Print .ReceivedTime Debug.Print .Subject Dim olInsp As Outlook.Inspector Set olInsp = .GetInspector Dim wdDoc As Word.Document Set wdDoc = olInsp.WordEditor Dim tb As Word.Table For Each tb In wdDoc.Tables 'assumes only 1 table Dim y as Long, x as Long For y = 0 To tb.Rows.Count For x = 0 To tb.Columns.Count Sheets("Sheet1").Range("A1").Offset(y, x).Value = tb.Cell(y, x).Range.Text Next Next Next End With GoTo AllDone End If 

Answer 2

即使苏格兰人给你一个很好的答案，我给我的答案，可能可以帮助别人。

这需要string，并创build一个表，parsing数据，在Excel中，偏移量1列，但这可以用一个.copy 。

 Sub convertToTable() Dim bigString As String Dim i Dim lenString Dim n Dim typeChar Dim r Dim rng As Range Dim lineLen Dim a Dim tLen Dim textR bigString = Range("A1").Value 'take the value from A1 lenString = Len(bigString) 'take the lenght Do 'go over the string spliting by the new line character (char10) i = i + 1 'just the index Range(Cells(i, 1), Cells(i, 1)).Value = Left(bigString, InStr(1, bigString, Chr(10))) 'important: 'use the col 1 to put the values in the sheet, here we split just into rows 'you can change the value of the column as you want bigString = Right(bigString, Len(bigString) - InStr(1, bigString, Chr(10))) 'here adjust the string to the rest of the text Loop While i < lenString r = Range(Cells(1, 1), Cells(1, 1)).End(xlDown).Row 'same as Range("A1").End Set rng = Range(Cells(1, 2), Cells(r, 2)) 'the whole range of data in col A a = 1 'here set 1 to use the column B (a = a + 1) 'if we delete the data there will be a trouble For Each i In rng 'for each cell/row in the data range in column A tLen = Len(i.Value) 'the lenght textR = i.Value 'the text Do a = a + 1 'the next column... Cells(i.Row, a).Value = Left(textR, InStr(1, textR, Chr(32))) 'Left(textR, InStr(1, textR, Chr(32))) 'this split the values using the space char (Chr(32)), but you can 'change it as you need, just find the spliting character textR = Right(textR, Len(textR) - InStr(1, textR, Chr(32))) Loop While InStr(1, textR, Chr(32)) <> 0 a = 1 Next i End Sub