Question

我正在设置一种自动解决方案，以将来自Outlook的传入邮件导出到Excel文件中。
我在网上找到了几种解决方案，但遇到编译错误。

我正在使用Outlook 2016和Windows 8.1。

我认为这是一个参考问题，但是我发现了FM20.DLL，它仍然无法正常工作。

我得到的错误：

编译错误：未定义用户定义类型

第Dim objExcelApp As Excel.Application行

Public WithEvents objMails As Outlook.Items

Private Sub Application_Startup()
    Set objMails = 
Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub objMails_ItemAdd(ByVal Item As Object)
    Dim objMail As Outlook.MailItem
    Dim strExcelFile As String
    Dim objExcelApp As Excel.Application
    Dim objExcelWorkBook As Excel.Workbook
    Dim objExcelWorkSheet As Excel.Worksheet
    Dim nNextEmptyRow As Integer
    Dim strColumnB As String
    Dim strColumnC As String
    Dim strColumnD As String
    Dim strColumnE As String

    If Item.Class = olMail Then
       Set objMail = Item
    End If

    'Specify the Excel file which you want to auto export the email list
    'You can change it as per your case
    strExcelFile = "H:\SF_Mail\Emails.xlsx"

    'Get Access to the Excel file
    On Error Resume Next
    Set objExcelApp = GetObject(, "Excel.Application")
    If Error <> 0 Then
       Set objExcelApp = CreateObject("Excel.Application")
    End If
    Set objExcelWorkBook = objExcelApp.Workbooks.Open(strExcelFile)
    Set objExcelWorkSheet = objExcelWorkBook.Sheets("Sheet1")

    'Get the next empty row in the Excel worksheet
    nNextEmptyRow = objExcelWorkSheet.Range("B" & objExcelWorkSheet.Rows.Count).End(xlUp).Row + 1

    'Specify the corresponding values in the different columns
    strColumnB = objMail.SenderName
    strColumnC = objMail.SenderEmailAddress
    strColumnD = objMail.Subject
    strColumnE = objMail.ReceivedTime

    'Add the vaules into the columns
    objExcelWorkSheet.Range("A" & nNextEmptyRow) = nNextEmptyRow - 1
    objExcelWorkSheet.Range("B" & nNextEmptyRow) = strColumnB
    objExcelWorkSheet.Range("C" & nNextEmptyRow) = strColumnC
    objExcelWorkSheet.Range("D" & nNextEmptyRow) = strColumnD
    objExcelWorkSheet.Range("E" & nNextEmptyRow) = strColumnE

    'Fit the columns from A to E
    objExcelWorkSheet.Columns("A:E").AutoFit

    'Save the changes and close the Excel file
    objExcelWorkBook.Close SaveChanges:=True
End Sub

Answer 1

参考

缺少参考文献时会出现此错误。
尝试添加Tools-> References：

Microsoft Excel [Your Version] Object Library
Microsoft Outlook [Your Version] Object Library

代码

尝试使用以下方法更改Excel App的初始化方式：

Dim objExcelApp As New Excel.Application

代替：

Dim objExcelApp As Excel.Application

因此您的代码将如下所示：

Private Sub objMails_ItemAdd(ByVal Item As Object)
    Dim objMail As Outlook.MailItem
    Dim strExcelFile As String
    Dim objExcelApp As New Excel.Application
    Dim objExcelWorkBook As Excel.Workbook
    Dim objExcelWorkSheet As Excel.Worksheet
    Dim nNextEmptyRow As Integer
    Dim strColumnB As String
    Dim strColumnC As String
    Dim strColumnD As String
    Dim strColumnE As String

    If Item.Class = olMail Then
       Set objMail = Item
    End If

    'Specify the Excel file which you want to auto export the email list
    'You can change it as per your case
    strExcelFile = "H:\SF_Mail\Emails.xlsx"

    'Get Access to the Excel file
    Set objExcelWorkBook = objExcelApp.Workbooks.Open(strExcelFile)
    Set objExcelWorkSheet = objExcelWorkBook.Sheets("Sheet1")

    'Get the next empty row in the Excel worksheet
    nNextEmptyRow = objExcelWorkSheet.Range("B" & objExcelWorkSheet.Rows.Count).End(xlUp).Row + 1

    'Specify the corresponding values in the different columns
    strColumnB = objMail.SenderName
    strColumnC = objMail.SenderEmailAddress
    strColumnD = objMail.Subject
    strColumnE = objMail.ReceivedTime

    'Add the vaules into the columns
    objExcelWorkSheet.Range("A" & nNextEmptyRow) = nNextEmptyRow - 1
    objExcelWorkSheet.Range("B" & nNextEmptyRow) = strColumnB
    objExcelWorkSheet.Range("C" & nNextEmptyRow) = strColumnC
    objExcelWorkSheet.Range("D" & nNextEmptyRow) = strColumnD
    objExcelWorkSheet.Range("E" & nNextEmptyRow) = strColumnE

    'Fit the columns from A to E
    objExcelWorkSheet.Columns("A:E").AutoFit

    'Save the changes and close the Excel file
    objExcelWorkBook.Close SaveChanges:=True
    objExcelApp.Quit 'Quit Excel application
End Sub

注释

通常，使用指令On Error Resume Next是一个坏主意，因为它可以抑制您在运行时执行时遇到的每个错误。但是，该规则有一些例外情况，您可以查看@FunThomas答案以进行澄清。

Answer 2

这并不是真正的答案，但是对@Louis的答案和以下讨论的评论太久了。

On Error Resume Next通常是邪恶的，但有时它是处理可能失败的语句的最佳方法。在这种情况下，命令Set objExcelApp = GetObject(, "Excel.Application")将Excel的运行实例分配给变量objExcelApp，但是如果Excel当前未处于活动状态，它将失败（并引发错误）。以下If Error <> 0 Then检查是否发生错误，如果是，它将打开一个 new Excel实例并将其分配给objExcelApp。

此时，Excel应该对宏有效，无论是现有实例还是新实例。仅当Excel根本不可用（未安装）或无法启动（内存不足）时，才可能出现例外。但是，On Error Resume Next仍处于活动状态，并将继续忽略所有运行时错误，这是错误。因此，在分配了变量之后，请恢复为标准错误处理，然后查看失败的原因：

'Get Access to the Excel file
On Error Resume Next
Set objExcelApp = GetObject(, "Excel.Application")
If Error <> 0 Then
   Set objExcelApp = CreateObject("Excel.Application")
End If
On Error Goto 0

如何修复编译错误：从Outlook使用Excel VBA时未定义用户定义类型？

2 个答案:

参考

代码

注释