Создание многоуровневого списка в Outlook из Excel VBA - PullRequest
1 голос
/ 06 марта 2020

Я работаю с Excel, чтобы обработать пользовательский ввод, а затем вывести стандартизированное электронное письмо на основе ввода, а затем взять этот форматированный текст и сохранить его в переменной, чтобы позже добавить его в буфер обмена для облегчения входа в систему, которую мы использовать для внутренней документации.

У меня есть функциональный подход, использующий HTML для формата электронной почты, но это не решает моего намерения заставить его скопировать код в буфер обмена или переменную, так как теги HTML также копируются. Я надеюсь получить функциональность списков маркеров Word, поэтому я пытался адаптировать код MS Word таким образом, чтобы его можно было вызывать по требованию.

В настоящее время у меня есть библиотеки Excel по умолчанию, библиотека форм и библиотека объектов для Word и Outlook добавлена ​​в программу.

Моя цель - передать список массивов, построенных на таблицах Excel, через список Word, отформатировать его и записать текст в редактор Word в черновике Outlook. Потребуется написать разное количество разделов (не более 6), обычно не более 10 элементов на раздел, обычно меньше. Поэтому я намерен заставить другие подфункции / функции вызывать это для форматирования каждого раздела по мере необходимости.

В приложении приведен пример вывода для этого раздела, а также пример того, откуда поступают данные. Каждый раздел будет иметь свой собственный лист в Excel. Второй уровень списка для каждого раздела будет взят с отдельного листа.

Я включил часть фактического кода, показывающую запуск нового черновика перспективы и ввод текста. EmailBody () в настоящее время просто обрабатывает любой текст за пределами этих разделов и вызывает отдельную функцию для каждого раздела для анализа таблиц (в настоящее время это неформатированный текст и ввод только разрывы строк).

Пример вывода

multilevel list in outlook body

Пример источника данных

table body for data source

Sub Email()

   Dim eTo As String
   eTo = Range("H4").Value

   Dim myItem As Object
   Dim myInspector As Outlook.Inspector

   Dim wdDoc As Word.Document
   Dim wdRange As Word.Range

Set myItem = Outlook.Application.CreateItem(olMailItem)
With myItem
    .To = eTo
    .Bcc = "email"
    .Subject = CNum("pt 1") & " | " & CNum("pt 2")
    'displays message prior to send to ensure no errors in email. Autosend is possible, but not recommended.
    .Display

    Set myInspector = .GetInspector
    'Obtain the Word.Document for the Inspector
    Set wdDoc = myInspector.WordEditor

     If Not (wdDoc Is Nothing) Then
         Set wdRange = wdDoc.Range(0, wdDoc.Characters.Count)
         wdRange.InsertAfter (EmailBody(CNum("pt 1"), CNum("pt 2")))
     End If
'[...]
end with
end sub

Код многоуровневого списка, который я пытаюсь адаптировать. Я продолжаю получать сообщение об ошибке в закомментированном разделе кода и не уверен, как правильно его исправить, чтобы он мог функционировать и вызываться по требованию:

Ошибка времени выполнения '450': Неверное количество аргументов или неверное присвоение свойства

Sub testList()

Dim arr1 As Object
Set arr1 = CreateObject("System.Collections.ArrayList")

With arr1
    .Add "test" & " $100"
    .Add "apple"
    .Add "four"
End With

Dim i As Long

 With ListGalleries(wdBulletGallery).ListTemplates(1).ListLevels(1)
    .NumberFormat = ChrW(61623)
    .TrailingCharacter = wdTrailingTab
    .NumberStyle = wdListNumberStyleBullet
    .NumberPosition = InchesToPoints(0.25)
    .Alignment = wdListLevelAlignLeft
    .TextPosition = InchesToPoints(0.5)
    .TabPosition = wdUndefined
    .ResetOnHigher = 0
    .StartAt = 1
    .LinkedStyle = ""
End With
ListGalleries(wdBulletGallery).ListTemplates(1).Name = ""
'Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
'    ListGalleries(wdBulletGallery).ListTemplates(1), ContinuePreviousList:= _
'    False, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
'    wdWord10ListBehavior

    'writes each item in ArrayList to document
    For i = 0 To arr1.Count - 1
        Selection.TypeText Text:=arr1(i)
        Selection.TypeParagraph
    Next i
    'writes each item to level 2 list
    Selection.Range.SetListLevel Level:=2
    For i = 0 To arr1.Count - 1
        Selection.TypeText Text:=arr1(i)
        Selection.TypeParagraph
    Next i
Selection.Range.ListFormat.RemoveNumbers NumberType:=wdNumberParagraph

arr1.Clear
End Sub

Пожалуйста, простите, если что-то из этого кажется неэффективным или странный подход. Я буквально забираю VBA несколько недель за go, и у меня есть только несколько часов применения между моими должностными обязанностями и тем, что я уже изучил. Любая помощь будет высоко ценится.

Ответы [ 2 ]

0 голосов
/ 07 марта 2020

Использование списков Word, в то время как функционирование в этих обстоятельствах создало определенную скуку в кодировании из-за необходимости объявлять объекты Word и Outlook и разрешать их связь друг с другом.

Кажется, я неправильно объявлял списки HTML в исходном коде. Я сдвинул поле <li>, а не вложил <ul>, чтобы шагнуть по списку.

Вложив теги списка HTML, вы можете получить те же функции, что и список слов, и форматирование сохранится при копировании в другие текстовые редакторы. Тем не менее, копирование должно быть сделано после того, как оно будет записано в .HTMLBody.

<ul><li>Apple</li><ul><li>Fruit</li></ul></ul>

или для VBA:

.HTMLBody = "<ul><li>" & arg1 & "</li><ul><li>" & arg2 & "</li></ul></ul>"

Выше будет выведено это в .HTMLBody:

  • Apple
  • Фрукты

Чтобы скопировать текст, вам нужно всего лишь выделить весь текст в редакторе слов Outlook, а затем назначить его буфер обмена, если он вставлен как есть, или назначьте его переменной, если перед внесением в буфер обмена необходимы дополнительные изменения.

0 голосов
/ 06 марта 2020

Причина, по которой вы получаете эту ошибку, заключается в том, что она не может разрешить объект Selection. Вам необходимо полностью квалифицировать объект Selection, иначе Excel будет ссылаться на текущий выбор из Excel.

Возможно, вы ссылались на библиотеку объектов Word из Excel, но этого недостаточно. Самый простой способ воспроизвести эту ошибку - запустить ее из Excel

Sub Sample()
    Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
    ListGalleries(wdBulletGallery).ListTemplates(1), ContinuePreviousList:= _
    False, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
    wdWord10ListBehavior
End Sub

enter image description here

Вот пример кода, который будет работать. Чтобы проверить это, откройте текстовый документ и выберите текст, а затем запустите этот код из Excel

Sub Sample()
    Dim wrd As Object

    Set wrd = GetObject(, "word.application")

    wrd.Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
    ListGalleries(wdBulletGallery).ListTemplates(1), ContinuePreviousList:= _
    False, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= wdWord10ListBehavior
End Sub

enter image description here

, применяя это к вашему коду. Вам нужно работать с объектами Word и полностью квалифицировать свои объекты, такие как Word Application, Word Document, Word Range et c. Например

Dim oWordApp As Object, oWordDoc As Object
Dim FlName As String

FlName = "C:\MyFile.Docx"

'~~> Establish an Word application object
On Error Resume Next
Set oWordApp = GetObject(, "Word.Application")

If Err.Number <> 0 Then
    Set oWordApp = CreateObject("Word.Application")
End If
Err.Clear
On Error GoTo 0

oWordApp.Visible = True

Set oWordDoc = oWordApp.Documents.Open(FlName)

With oWordDoc
    '
    '~~> Rest of the code here
    '
End With
...