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

來源

2017-03-01 Jason Leach

嘗試在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

來源

2017-03-02 15:38:09 R3uK

Outlook電子郵件導出到Excel - 觸發Excel工作簿中的VBA

回答

相關問題