Я добавил Option Explicit в начало вашего кода. Это очень полезно при поиске ошибок во время компиляции.
Dim myOlApp As Outlook.Application
Set objItem = objApp.ActiveExplorer.Selection.Item(1)
Вы объявляете myOlApp, но используете objApp без его инициализации.
Dim myOlMailItem As Outlook.MailItem
Set objItem = myOlApp.ActiveExplorer.Selection.Item(1)
Вы объявляете myOlMailItem, но вы используете objItem.
i = 0
For j = 0 To UBound(messageArray)
Вы не объявляете i или j. Если вы опустите Option Explicit, вам не нужно объявлять каждую переменную, потому что они будут объявлены для вас как тип Variant. Однако это означает, что каждая незначительная орфографическая ошибка становится новой переменной. Например:
Count = Conut +1
Conut будет объявлено как новая переменная и инициализировано нулем.
Я не получаю «Определяемый пользователем тип не определен». Думая об этом, я понял, что сделал ложное предположение о том, где находится этот код.
Вы пишете, например, Dim myNameSpace As Outlook.NameSpace и Dim anchor As Range.
Вы можете написать VBA в пределах Outlook для доступа к рабочему листу Excel или вы можете написать VBA в Excel для доступа к папке Outlook. Если вы находитесь в Outlook, вы должны сообщить компилятору Outlook VBA, что вы хотите получить доступ к Excel. И наоборот. Вы префикс NameSpace, но вы не префикс Range. Я предположил, что этот код был в книге Excel. Но, если подумать, теперь я считаю, что этот код находится в Outlook. Перечитывая ваш вопрос, я вижу, что вы говорите, что это Outlook VBA; Я пропустил это при первом чтении.
Не имеет значения, где находится этот код; это не может работать. Если вы находитесь в Outlook, вы не можете ссылаться на активный лист, не открыв книгу Excel в первую очередь. Если вы находитесь в Excel, какое электронное письмо выбрал пользователь?
Давайте отступим от кода и рассмотрим ваши варианты дизайна.
Использование ActiveExplorer - мой любимый метод тестирования нового макрос обработки электронной почты. Я могу выбрать простое письмо для моего первого теста. Я могу исправить макрос и повторно запускать его для одного и того же электронного письма так же часто, как я sh. Когда макрос работает с простыми электронными письмами, я могу попробовать его на более сложных. Однако, как только мой новый макрос работает правильно, я хочу автоматизировать выделение. Я не хочу думать: «Это 12:00, пришло ли какое-нибудь из этих писем сегодня утром? Если это так, мне нужно go зайти в Outlook, найти все поступившие и обработать их ». Я хочу подумать: «Сейчас 12:00, есть ли новые электронные письма, скопированные в мою книгу Excel».
Существует четыре различных способа выбора электронной почты для обработки. Вы не можете смешивать и сочетать. Этими способами являются:
- Выбор пользователя, который является методом, который вы пытаетесь.
- Вы можете прочитать папку (от самой старой до самой новой) или вверх папку (от самой новой до самой старой) или вы можете отсортировать папку по любым обычным свойствам.
- Вы можете создать правило, которое предписывает Outlook отслеживать входящие сообщения для определенных сообщений и делать что-то, когда они приходят.
- Вы можете использовать события для попросите Outlook вызывать макрос всякий раз, когда новое сообщение помещается в определенную папку.
При способе 1 именно пользователь идентифицирует электронное письмо, которое будет обработано. С другими методами должен быть тест, который может выполнить макрос. Это письма от одного отправителя? Есть ли в этих письмах конкретная тема или конкретная фраза в теме? Если не выполнить простую проверку, вы можете найти в теле «Region», «Country» и «Contactable by».
Проблема с методами 3 и 4 заключается в том, что макрос вызывается при получении одного из этих писем. прибыть. Макрос должен быстро открыть книгу, обновить ее и закрыть. Что произойдет, если электронное письмо поступит во время обработки рабочей книги пользователем? Я не хотел бы решать эту проблему, если бы я был новичком в VBA, как и вы.
Я бы использовал метод 2. У меня была бы книга Excel, которая содержала макрос, который обращался к папке «Входящие» Outlook и просматривал новейшие электронные письма. для любого из целевых электронных писем. Это не совсем то, что я сказал, что хотел, но это достаточно близко. Каждый раз, когда я открываю книгу, я могу, если я sh, запускать макрос для обработки любых новых писем. Это может занять всего несколько секунд, если макрос выполняется регулярно.
Возможно, стоит использовать правило для перемещения этих сообщений в специальную папку. Это будет означать, что макрос не должен искать в почтовых ящиках эти электронные письма. Это может выглядеть так, как будто я смешиваю методы 2 и 3, но не в одном макросе. Всякий раз, когда вы открываете Outlook, новые письма приходят с сервера, и правило будет перемещать любые целевые письма в их папку. Открыв рабочую книгу, вы можете проверить наличие новых целевых электронных писем или просмотреть те электронные письма, которые уже записаны в рабочей книге.
Я думаю, этого достаточно, чтобы вы могли подумать на данный момент. Просмотрите подходы, которые я обсуждал, и примите некоторые решения относительно того, что вы хотите.
Часть 2
У меня не было свободного времени, которого я ожидал этим вечером, поэтому я сомневаюсь Я закончу сегодня 1135 *. У меня также проблема в том, что мне следовало задать больше вопросов о вашем требовании.
Чтобы дать вам возможность взглянуть на завтра, я подготовил демонстрационный макрос, который включает в себя много того, что вам нужно знать, и который я думаю, что вы найдете полезное для понимания окончательного макроса.
Я создал рабочую книгу и рабочий лист с заголовком, который соответствует указанному в вашем вопросе. Я назвал книгу «Электронная почта Data.xlsx» и разместил ее на своем рабочем столе. Я назвал лист «Данные электронной почты». Я предполагаю, что у вас разные имена и другое местоположение. Макрос сообщает, что нужно изменить.
Макрос Outlook, который хочет получить доступ к книге Excel, должен иметь доступ к библиотеке Excel. Вы можете знать, как добавлять ссылки, но на всякий случай:
- Откройте редактор Outlook VBA.
- Нажмите [Инструменты] на стандартной панели инструментов, затем [Ссылки…].
- Отображается список доступных ссылок. Некоторые доступные ссылки вверху (например, Visual Basi c for Application) отмечены галочкой. Большинство ссылок не помечены галочкой.
- Если отмечена галочка «Библиотека объектов Microsoft Excel nn.n», нажмите [Отмена], поскольку делать нечего. Примечание: значение «nn.n» зависит от используемой версии Outlook и Excel. Этот код должен работать с любой версией Excel, поэтому не имеет значения, используете ли вы старую версию.
- Если «Библиотека объектов Microsoft Excel nn.n» не отмечена, прокрутите список вниз, пока не найдете эту ссылку и щелкните поле слева, чтобы отметить его.
- Нажмите [OK].
- Повторите шаг 2 и убедитесь, что «Библиотека объектов Microsoft Excel nn.n» теперь отображается вверху. списка и отмечен галочкой.
Скопируйте этот макрос в модуль Outlook:
Option Explicit
Sub DemoOpenWorkbook()
' Needs reference to Microsoft Excel n.nn Object Library
' where n.nn depends on the version of Office being used
Dim Path As String
Dim WbkEmailData As Excel.Workbook
Dim WshtEmailData As Excel.Worksheet
Dim XlApp As New Excel.Application
' Replace with path to the folder which holds your workbook
Path = CreateObject("WScript.Shell").specialfolders("Desktop")
With XlApp
.Visible = True ' Slows your application but makes debugging easier
' Replace "Email Data.xlsx" with the name of your workbook
Set WbkEmailData = .Workbooks.Open(Path & "\Email Data.xlsx")
End With
With WbkEmailData
' Replace "Email Data" with the name of your worksheet
Set WshtEmailData = .Worksheets("Email Data")
End With
With WshtEmailData
Debug.Print .Cells(1, 1).Value
Debug.Print .Cells(1, 2).Value
Debug.Print .Cells(1, 3).Value
End With
WbkEmailData.Close
Set WshtEmailData = Nothing
Set WbkEmailData = Nothing
XlApp.Quit
Set XlApp = Nothing
End Sub
Внесите изменения, которые я обсуждал выше. Запустите макрос. Рабочая книга открывается, первые три заголовка рабочей таблицы выводятся в окно «Немедленно», а рабочая книга закрывается. Немедленное окно теперь будет содержать:
DATE OF RECEIPT
DELIVERY DATE
MONTH
Отработайте мой код. Если вы не понимаете ни одного из моих утверждений, посмотрите их. В целом, введя что-то вроде «Outlook VBA Name-of-Statement-You-Not-Un-понимать» в вашей любимой поисковой системе, вы найдете объяснение. При необходимости вернитесь с вопросами, но я надеюсь, что вы поймете, почему этот код работает без дополнительной помощи от меня.
Примечание: вам не нужно запоминать этот код. Существуют операторы VBA и блоки кода VBA, которые я набираю достаточно часто, чтобы запомнить их. Но мне не стыдно искать что-то, что я использую нечасто, или оглядываться на рабочий макрос, который делает что-то похожее на то, что я хочу сделать сегодня.
Part3
Следующие два макроса демонстрируют мою любимую технику для тестирования нового макроса обработки электронной почты. В нижней части TestNewEmailProcessingMacro вы найдете оператор Call EmailProcessingMacro(ItemCrnt). Когда я создаю новый макрос для обработки электронной почты, я изменяю этот оператор, чтобы вызвать мой новый макрос. Затем я выбираю простое электронное письмо типа моих макросов перед запуском TestNewEmailProcessingMacro(). Я тщательно проверяю, что мой макрос правильно обрабатывает простую электронную почту. Если нет, я могу исправить макрос и повторять тест так часто, как это необходимо. Как только мой макрос правильно обрабатывает простое письмо, я могу попробовать более сложные письма. Я продолжаю, пока мой макрос не выполнит меня полностью. Затем я бы назвал свой новый макрос из al oop правилом или событием, как описано в первой части моего ответа.
Sub TestNewEmailProcessingMacro()
Dim Exp As Explorer
Dim ItemCrnt As MailItem
Set Exp = Outlook.Application.ActiveExplorer
If Exp.Selection.Count = 0 Then
Call MsgBox("Please select one or more emails then try again", vbOKOnly)
Exit Sub
Else
For Each ItemCrnt In Exp.Selection
If ItemCrnt.Class = olMail Then
Call EmailProcessingMacro(ItemCrnt)
End If
Next
End If
End Sub
Public Sub EmailProcessingMacro(ByRef ItemCrnt As MailItem)
With ItemCrnt
Debug.Print .ReceivedTime & " " & .Subject
End With
End Sub
Приведенный выше код показывает, как правильно использовать Проводник. В вашем коде у вас есть Set objItem = objApp.ActiveExplorer.Selection.Item(1). Это попытается получить доступ к первому выбранному электронному письму, даже если ни одно из них не выбрано, и игнорирует любые дальнейшие электронные письма, которые были выбраны.
Далее я покажу вам, как объединить методы, показанные в приведенных выше макросах.
Часть 4
Ниже приведены два макроса, которые вместе делают то, что я думаю, что вы хотите.
Вам нужно будет внести те же изменения, которые были необходимы с DemoOpenWorkbook() , То есть вам придется изменить путь, имя рабочей книги и имя рабочей таблицы. Вам не нужно будет добавлять еще одну ссылку в библиотеку Excel, достаточно один раз.
Выберите одно или несколько из этих писем, а затем запустите макрос CtrlCopyEmailDataToExcel(). Это макрос, который открывает книгу, а затем сохраняет изменения. Этот макрос вызывает CopyEmailDataToExcel() для каждого выбранного письма. Это макрос, который декодирует тело письма, извлекает из него четыре значения и копирует их на лист. Он также извлекает необходимые свойства из электронной почты и копирует их в рабочую книгу. Я задокументировал все свои предположения об электронной почте и листе в макросе. Сделайте копию своей рабочей книги на случай, если мои предположения неверны и макрос повредит рабочую книгу. Однако я надеюсь, что макросы будут соответствовать вашим требованиям.
Я надеюсь, что объяснил принципы, лежащие в основе моего кода, чтобы вы понимали, что происходит, и могли создавать свои собственные макросы для выполнения аналогичного копирования данных из электронных писем в Excel.
Sub CtrlCopyEmailDataToExcel()
' Extracts data from selected emails and copies it to Excel
' Needs reference to Microsoft Excel n.nn Object Library
' where n.nn depends on the version of Office being used
Dim Exp As Explorer
Dim ItemCrnt As MailItem
Dim Path As String
Dim RowCrnt As Long
Dim WbkEmailData As Excel.Workbook
Dim WshtEmailData As Excel.Worksheet
Dim XlApp As New Excel.Application
Set Exp = Outlook.Application.ActiveExplorer
If Exp.Selection.Count = 0 Then
Call MsgBox("Please select one or more emails then try again", vbOKOnly)
Exit Sub
Else
' Replace with path to the folder which holds your
Path = CreateObject("WScript.Shell").specialfolders("Desktop")
With XlApp
.Visible = True ' Slows your application but makes debugging easier
' Replace "Email Data.xlsx" with the name of your workbook
Set WbkEmailData = .Workbooks.Open(Path & "\Email Data.xlsx")
End With
With WbkEmailData
' Replace "Email Data" with the name of your worksheet
Set WshtEmailData = .Worksheets("Email Data")
End With
With WshtEmailData
' If the cursor is placed in the bottom cell of column A and Up Arrow
' clicked, the cursor will be move up to the last row with data in
' column A. This is the VBA equivalent. Adding 1 means RowCrnt will
' become the number of the first unused row. This relies on every
' used row having a value column A. Replace "A" if another column is
' a better choice. If no column is guaranteed to not contain blank
' cell, I can provide a routine that finds the last used row in a
' different way.
RowCrnt = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
For Each ItemCrnt In Exp.Selection
Call CopyEmailDataToExcel(ItemCrnt, WshtEmailData, RowCrnt)
Next
End If
WbkEmailData.Close SaveChanges:=True
Set WshtEmailData = Nothing
Set WbkEmailData = Nothing
XlApp.Quit
Set XlApp = Nothing
End Sub
Sub CopyEmailDataToExcel(ByRef ItemCrnt As MailItem, _
ByRef WshtEmailData As Worksheet, _
ByRef RowCrnt As Long)
' The Body of ItemCrnt is the HtmlBody with all the Html tags stripped out.
' Most the HtmlBody was a table with two cells per row. The left-hand cell
' would be a keyword such as "Country", "Role" or "Product" while the
' right-hand cell would be the value associated with the keyword. The nature
' of the HtmBody and the nature of the conversion to text means a table row
' would become, for example: Country CR LF CR LF France CR LF CR LF
' The bottom of the table had only one cell per row. This is achieved with a
' "ColSpan = 2" attribute in the first and only <td> of the row. The change
' of style starts with a cell containing "Message". These final rows are:
' Message CR LF CR LF Line1 CR LF CR LF Line2 CR LF CR LF ...
' The last two lines of this block are not required.
' The start of Body did not come from the same Html table and the format is
' slightly different. However, the start of Body contains nothing of
' interest.
' Two properties of ItemCrnt are to be copied to the worksheet: SentOn (Date
' email sent) and SenderName.
' The month of property Sent On is required for another column.
' This routine copies the seven values from ItemCrnt to RowCrnt of the
' worksheet and then steps RowCrnt ready for the next row.
Const ColReceived As Long = 1
Const ColSentOn As Long = 2 ' Delivery Date
Const ColMonth As Long = 3
Const ColCountry As Long = 4
Const ColEnqType As Long = 6 ' Role
Const ColProduct As Long = 7
Const ColMessage As Long = 8 ' Question
Dim BodyLines() As String
Dim InxL As Long
Dim Key As String
Dim LenKey As Long
Dim Message As String
Dim MessageFound As Boolean
Dim Ub As Long
' At the start of ItemCrnt.Body, the lines are separated by single CRLFs.
' However, the start of ItemCrnt.Body contains nothing of interest so it
' does not matter that it is not split correctly.
BodyLines = Split(ItemCrnt.Body, vbCrLf & vbCrLf)
' Ignore any trailing blank lines
For Ub = UBound(BodyLines) To LBound(BodyLines) Step -1
If BodyLines(Ub) <> "" Then
Exit For
End If
Next
With WshtEmailData
MessageFound = False
InxL = LBound(BodyLines)
Do While InxL <= Ub
If InStr(1, BodyLines(InxL), "Country") <> 0 Then
' The country is the next row
InxL = InxL + 1
.Cells(RowCrnt, ColCountry).Value = BodyLines(InxL)
ElseIf InStr(1, BodyLines(InxL), "Role") <> 0 Then
' The role is the next row
InxL = InxL + 1
.Cells(RowCrnt, ColEnqType).Value = BodyLines(InxL)
ElseIf InStr(1, BodyLines(InxL), "Product") <> 0 Then
' The product is the next row
InxL = InxL + 1
.Cells(RowCrnt, ColProduct).Value = BodyLines(InxL)
ElseIf InStr(1, BodyLines(InxL), "Message") <> 0 Then
' The message starts in the next row
InxL = InxL + 1
MessageFound = True
Exit Do
End If
InxL = InxL + 1
Loop
If MessageFound Then
'Build message as Line1 vbLF Line2 vbLF Line3 and so on
Message = BodyLines(InxL)
For InxL = InxL + 1 To Ub
If BodyLines(InxL) = "AAA-BBB-001366" Then
Exit For
End If
Message = Message & vbLf & BodyLines(InxL)
Next
With .Cells(RowCrnt, ColMessage)
.Value = Message
.WrapText = True
End With
End If
With .Cells(RowCrnt, ColReceived)
.Value = ItemCrnt.ReceivedTime
.NumberFormat = "dmmmyy"
End With
With .Cells(RowCrnt, ColSentOn)
.Value = ItemCrnt.SentOn
.NumberFormat = "dmmmyy"
End With
With .Cells(RowCrnt, ColMonth)
.Value = ItemCrnt.ReceivedTime
.NumberFormat = "mmm"
End With
End With
RowCrnt = RowCrnt + 1
End Sub