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

问题描述：

我只是想了解这里发生了什么。Outlook电子邮件导出到Excel - 触发Excel工作簿中的VBA

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

在该工作簿中，我使用了VBA代码来分析数据，以便它实际上可用（在这种情况下，现在是主题行，最终是主体）。

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

例如：列A & B是正确的，A是CREATIONTIME，B是全SubjectLine

列C，d，E，ECT将是电子邮件的主题行随机解析的比特。

导出为excel时，Excel工作簿中的马可斯是否正在运行？

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

这里是我的前景代码：

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

尝试在Excel中的操作之前添加'appExcel.EnableEvents = False'并在完成时添加'appExcel.EnableEvents = True' – R3uK

完美工作！出于好奇，为什么它考虑导入事件？这是我的代码或VBA内的东西吗？ –

你正在调用的* import *是事实上将数据写入Excel工作表，所以你可能触发了'Worksheet_Change'事件，并且是很多其他可能触发的事件。我做出了所有这些形式化的答案，请花一点时间参加[游览]（点击它）并接受我的答案！ ;） – R3uK

答

您需要包装在Excel中你的行动：

appExcel.EnableEvents = False（之前在Excel中你的行动），并
appExcel.EnableEvents = True当您完成in 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

相关推荐