Outlook VBA调用excel会导致崩溃

Question

我正在努力使用outlook / excel vba代码，以便在每次运行时正确结束。

我每次收到新邮件时都会运行当前脚本。此地址上的所有邮件都是来自网站（wordpress）的注册，并包含如下所示的标准格式：

Navn: John Doe 

Deltakelse: I/we arrive on friday

Spesielle mathensyn: some random text here

Epost: john.doe@emailprovider.com

Kommentar: Some random text here

Time: mai 25, 2017 at 6:02 pm
IP Adresse: 127.0.0.1
Contact Form URL: https://mysite.wordpress.com/
Sendt av en ubekreftet besøkende til ditt nettsted.

我想提取信息并自动更新RVSP.xlsx文档（除了发送一个运行良好的自动回复邮件！）。我已经验证我设法提取了我想要的文本，但是每次脚本崩溃/停止时我都必须手动结束它。我怀疑我没有正确关闭excel应用程序，但我已经尝试了解自己并且我没有更明智。有人可以帮帮我吗？

这是outlook vba代码

Public Const ColNavn As Integer = 1
Public Const ColDeltakelse As Integer = 2
Public Const ColMathensyn As Integer = 3
Public Const ColEpost As Integer = 4
Public Const ColKommentar As Integer = 5
Public Const ColRegistrert As Integer = 6

Sub SendNew(Item As Outlook.MailItem)
   Dim Reg1 As Object
    Dim M1 As Object
    Dim M As Object
    Dim strAddress As String
    Dim navn As String
    Dim deltakelse As String
    Dim mathensyn As String
    Dim kommentar As String

Set Reg1 = CreateObject("VBScript.RegExp")

    With Reg1
       .Pattern = "(([\w-\.]*\@[\w-\.]*)\s*)"
       .IgnoreCase = True
       .Global = False
    End With

If Reg1.Test(Item.Body) Then

        Set M1 = Reg1.Execute(Item.Body)
        For Each M In M1
           strAddress = M.SubMatches(1)
        Next
End If

With Reg1
       .Pattern = "(Navn[:]([\w-\s]*)\s*)Deltakelse"
       .IgnoreCase = True
       .Global = False
    End With

If Reg1.Test(Item.Body) Then

        Set M1 = Reg1.Execute(Item.Body)
        For Each M In M1
           navn = M.SubMatches(1)
        Next
End If

deltakelse = "testDeltakelse"
mathensyn = "mathensyn test2"
kommentar = "kommentar med fire ord"

Call Svar(navn, deltakelse, mathensyn, strAddress, kommentar)

 Dim objMsg As MailItem
 Set objMsg = Application.CreateItemFromTemplate("E:\Dropbox\Bryllup\Mail\mal.oft")

 objMsg.Recipients.Add strAddress

 ' Copy the original message subject
 objMsg.Subject = "Takk for svar"

' use for testing
' objMsg.Display

 objMsg.Send

 End Sub

Sub Svar(navn As String, deltakelse As String, mathensyn As String, epost As String, kommentar As String)

  Dim xlApp As Excel.Application
  Dim ExcelWkBk As Excel.Workbook
  Dim FileName As String
  Dim PathName As String

  PathName = "E:\Dropbox\Bryllup\Mail\"
  FileName = "RSVP.xlsx"

  Set xlApp = Application.CreateObject("Excel.Application")
  With xlApp
    '.Visible = True         ' This slows your macro but helps during debugging
    Set ExcelWkBk = xlApp.Workbooks.Open(PathName & FileName)
    With ExcelWkBk

      ' Add Excel VBA code to update workbook here
        Dim RowNext As Integer

        With Sheets("Ark1")     '   Replace with the name of your worksheet
            ' This finds the bottom row with a value in column A.  It then adds 1 to get
            ' the number of the first unused row.
            RowNext = .Cells(Rows.Count, "A").End(xlUp).Row + 1
        End With

        With Sheets("Ark1")     '   Replace with the name of your worksheet

            .Cells(RowNext, ColNavn).Value = navn
            .Cells(RowNext, ColDeltakelse).Value = deltakelse
            .Cells(RowNext, ColMathensyn).Value = mathensyn
            .Cells(RowNext, ColEpost).Value = epost
            .Cells(RowNext, ColKommentar).Value = kommentar
            With .Cells(RowNext, ColRegistrert)
                .Value = Now()
                ' This format means the time is stored and I can access it but it
                'is not displayed.  Change to "mm/dd/yy" or whatever you like.
                .NumberFormat = "dd.mm.yy"
            End With
            'RowNext = RowNext + 1   ' Ready for next loop

        End With
        .Save
        .Close
    End With
  End With
  Set ExcelWkBk = Nothing
  xlApp.Quit
  Set xlApp = Nothing
End Sub

我使用Outlook 2016和excel 2016。