java导出到邮件_Outlook 电子邮件导出到 Excel-在 Excel 工作簿中触发 VBA

我只是想了解这里发生的事情。

我在 Outlook 中有代码，可以将选定文件夹中的所有电子邮件导出到 Excel 工作簿中。

在该工作簿中，我使用了 VBA 代码来解析数据，因此它实际上是可用的(在这种情况下，目前为主题行，最终为主体)。

从 Outlook 导出到“ .xlsx”文件时，一切看起来都很不错，但是，当导出到“ .xlsm”文件时，它会在其他列中添加与正确导入的信息不符的信息。

例如：A 和 B 列正确，A 是 CreationTime，B 是完整的 SubjectLine

C，D，E 等列将是电子邮件主题行的随机分析位。

导出到 excel 时，Excel 工作簿中的 marcos 是否正在运行？

如果是这样，我该如何预防呢？

这是我的 Outlook 代码：

Sub ExportToExcel()

On Error GoTo ErrHandler

Dim appExcel As Excel.Application

Dim wkb As Excel.Workbook

Dim wks As Excel.Worksheet

Dim rng As Excel.Range

Dim strSheet As String

Dim strPath As String

Dim intRowCounter As Integer

Dim intColumnCounter As Integer

Dim msg As Outlook.MailItem

Dim nms As Outlook.NameSpace

Dim fld As Outlook.MAPIFolder

Dim itm As Object

'Opens the Workbook and Sheet to paste in

strSheet = "Tester.xlsx"

strPath = "G:\Jason\"

strSheet = strPath & strSheet

Debug.Print strSheet

'Select export folder

Set nms = Application.GetNamespace("MAPI")

Set fld = nms.PickFolder

'Handle potential errors with Select Folder dialog box.

If fld Is Nothing Then

MsgBox "There are no mail messages to export", vbOKOnly, "Error"

Exit Sub

ElseIf fld.DefaultItemType <> olMailItem Then

MsgBox "There are no mail messages to export", vbOKOnly, "Error"

Exit Sub

ElseIf fld.Items.Count = 0 Then

MsgBox "There are no mail messages to export", vbOKOnly, "Error"

Exit Sub

End If

'Open and activate Excel workbook.

Set appExcel = CreateObject("Excel.Application")

appExcel.Workbooks.Open (strSheet)

Set wkb = appExcel.ActiveWorkbook

Set wks = wkb.Sheets(1)

wks.Activate

appExcel.Application.Visible = True

'Copy field items in mail folder.

For Each itm In fld.Items

intColumnCounter = 1

Set msg = itm

intRowCounter = intRowCounter + 1

Set rng = wks.Cells(intRowCounter, intColumnCounter)

rng.Value = msg.CreationTime

intColumnCounter = intColumnCounter + 1

Set rng = wks.Cells(intRowCounter, intColumnCounter)

rng.Value = msg.Subject

Next itm

Set appExcel = Nothing

Set wkb = Nothing

Set wks = Nothing

Set rng = Nothing

Set msg = Nothing

Set nms = Nothing

Set fld = Nothing

Set itm = Nothing

Exit Sub

ErrHandler: If Err.Number <> 0 Then

MsgBox strSheet & " doesn't exist", vbOKOnly, "Error"

End If

Set appExcel = Nothing

Set wkb = Nothing

Set wks = Nothing

Set rng = Nothing

Set msg = Nothing

Set nms = Nothing

Set fld = Nothing

Set itm = Nothing

End Sub

Here is the Parsing Code in Excel:

Sub SplitSubjectLine()

Dim text As String

Dim i As Integer

Dim y As Integer

Dim LastRow As Long

Dim name As Variant

ReDim name(3)

LastRow = Cells(Rows.Count, "A").End(xlUp).Row

For y = 1 To LastRow

Cells(y, 2).Select

text = ActiveCell.Value

name = Split(text, ",")

For i = 0 To UBound(name)

Cells(y, i + 2).Value = name(i)

Next i

Next

End Sub