Outlook電子メールをExcelにエクスポート - ExcelワークブックでVBAを起動する

Question

ここで何が起こっているのかを理解しようとしています。

私は、選択したフォルダ内のすべての電子メールをExcelブックにエクスポートするコードをOutlookに用意しています。

このワークブックでは、実際に使用できるようにデータを解析するために使用しているVBAコードがあります（この場合は件名、最終的に本文）。

outlookから ".xlsx"ファイルにエクスポートすると、すべてが素晴らしいように見えますが、 ".xlsm"ファイルにエクスポートすると、インポートされた正しい情報と一致しない情報が追加されます。

例：列& Bが正しい、AはCREATIONTIMEあり、Bが満杯SubjectLineある

列C、D、E、ECTは、電子メールの件名のランダム解析されたビットであろう。

エクセルのエクスポートが実行されているときに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 

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