Question

我只是想了解这里发生了什么。

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

在该工作簿中，我使用VBA代码来解析数据，因此它实际上是可用的（在这种情况下是主题行，现在最终是正文）。

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

Ex：A栏和A组; B是正确的，A是CreationTime，B是完整的SubjectLine

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

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

如果是这样，我该如何防止这种情况？

这是我的展望代码：

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

Answer 1

您需要使用以下命令将操作包装在Excel中：

appExcel.EnableEvents = False（在Excel中执行操作之前）和
appExcel.EnableEvents = True在Excel完成后

伪代码：

''Start of your sub

Set appExcel = CreateObject("Excel.Application")
appExcel.EnableEvents = False

''Your actions in Excel

appExcel.EnableEvents = True

''End of your sub

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

1 个答案: