Как исправить ошибку компиляции: пользовательский тип не определен при использовании Excel VBA из Outlook?

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

Это не совсем ответ, но он слишком длинный для комментария к ответу @Louis и последующего обсуждения.

On Error Resume Next обычно является злом, но иногда это лучший способ справиться с утверждением, которое может потерпеть неудачу. В этом случае команда Set objExcelApp = GetObject(, "Excel.Application") назначит запущенный экземпляр Excel переменной objExcelApp, но потерпит неудачу (и выдаст ошибку), если Excel в данный момент не активен. Следующий If Error <> 0 Then проверяет, произошла ли ошибка, и если да, он откроет новый экземпляр Excel и назначит его objExcelApp.

В этот момент Excel должен быть доступен для макроса, существующего или нового экземпляра. Исключением может быть только то, что Excel вообще недоступен (не установлен) или не может быть запущен (не хватает памяти). Однако On Error Resume Next все еще активен и будет по-прежнему игнорировать все ошибки времени выполнения, а это bad . Итак, после присвоения переменной вернитесь к стандартной обработке ошибок и посмотрите, что не получается:

'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

Answer 2

Рекомендации

Это ошибка, которая появляется, когда ссылка отсутствует.
Попробуйте добавить в 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 для уточнения.