Note: The other languages of the website are Google-translated. Back to English

Как вставить подпись Outlook при отправке электронной почты в Excel?

Предположим, вы хотите отправить электронное письмо непосредственно в Excel, как вы можете добавить подпись Outlook по умолчанию в электронное письмо? В этой статье представлены два метода, которые помогут вам добавить подпись Outlook при отправке электронной почты в Excel.

Вставить подпись в электронную почту Outlook при отправке в Excel VBA
Легко вставляйте подпись Outlook при отправке электронной почты в Excel с помощью замечательного инструмента

Дополнительные руководства по рассылке писем в Excel ...


Вставить подпись в электронную почту Outlook при отправке в Excel VBA

Например, на листе есть список адресов электронной почты, чтобы отправлять электронные письма на все эти адреса в Excel и добавлять в электронные письма подпись Outlook по умолчанию. Пожалуйста, примените приведенный ниже код VBA для его достижения.

1. Откройте рабочий лист, содержащий список адресов электронной почты, на который вы хотите отправить электронное письмо, а затем нажмите другой + F11 ключи.

2. В дебюте Microsoft Visual Basic для приложений окна, нажмите Вставить > Модуль, а затем скопируйте ниже ВБА 2 в окно кода модуля.

3. Теперь вам нужно заменить .Тело линии в ВБА 2 с кодом в ВБА 1. После этого переместите строку .Отображать под линией С xMailOut.

VBA 1: Шаблон отправки электронных писем с подписью Outlook по умолчанию в Excel

.HTMLBody = "This is a test email sending in Excel" & "<br>" & .HTMLBody

VBA 2: отправка электронной почты на адреса электронной почты, указанные в ячейках Excel

Sub SendEmailToAddressInCells()
    Dim xRg As Range
    Dim xRgEach As Range
    Dim xRgVal As String
    Dim xAddress As String
    Dim xOutApp As Outlook.Application
    Dim xMailOut As Outlook.MailItem
    On Error Resume Next
    xAddress = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Please select email address range", "KuTools For Excel", xAddress, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xOutApp = CreateObject("Outlook.Application")
    Set xRg = xRg.SpecialCells(xlCellTypeConstants, xlTextValues)
    For Each xRgEach In xRg
        xRgVal = xRgEach.Value
        If xRgVal Like "?*@?*.?*" Then
            Set xMailOut = xOutApp.CreateItem(olMailItem)
            With xMailOut
                .To = xRgVal
                .Subject = "Test"
                .Body = "Dear " _
                      & vbNewLine & vbNewLine & _
                        "This is a test email " & _
                        "sending in Excel"
                .Display
                '.Send
            End With
        End If
    Next
    Set xMailOut = Nothing
    Set xOutApp = Nothing
    Application.ScreenUpdating = True
End Sub

Следующий снимок экрана может помочь вам легко найти различия после изменения кода VBA.

4. нажмите F5 ключ для запуска кода. Потом Kutools for Excel появится всплывающее окно выбора, выберите адреса электронной почты, на которые вы будете отправлять электронные письма, а затем нажмите ОК.

Затем создаются электронные письма. Вы можете видеть, что подпись Outlook по умолчанию добавляется в конец тела электронной почты.

Советы:

  • 1. Вы можете изменить текст сообщения электронной почты в коде VBA 1 в зависимости от ваших потребностей.
  • 2. Если после запуска кода появится диалоговое окно с предупреждением о том, что пользовательский тип не определен, закройте это диалоговое окно и затем нажмите Инструменты > Рекомендации в Microsoft Visual Basic для приложений окно. В открытии Ссылки - VBAProject окно, проверьте Библиотека объектов Microsoft Outlook поле и нажмите ОК. А затем снова запустите код.

Легко вставляйте подпись Outlook при отправке электронной почты в Excel с помощью замечательного инструмента

Если вы новичок в VBA, здесь настоятельно рекомендуем Отправить письма полезности Kutools for Excel для вас. С помощью этой функции вы можете легко отправлять электронные письма на основе определенных полей в Excel и добавлять к ним подпись Outlook. Пожалуйста, сделайте следующее.

Перед применением Kutools for Excel, Пожалуйста, сначала скачайте и установите.

Во-первых, вам нужно создать список рассылки с различными полями, на основе которых вы будете отправлять электронные письма.

Вы можете вручную создать список рассылки по своему усмотрению или применить функцию «Создать список рассылки», чтобы быстро это сделать.

1. Нажмите Кутулс Плюс > Создать список рассылки.

2. в Создать список рассылки в диалоговом окне укажите нужные поля, выберите, куда выводить список, а затем щелкните значок OK кнопку.

3. Теперь образец списка рассылки создан. Поскольку это примерный список, вам необходимо изменить поля на определенное необходимое содержимое. (допускается несколько строк)

4. После этого выделите весь список (включая заголовки), нажмите Кутулс Плюс > Отправить электронную почту.

5. в Отправить письма диалоговое окно:

  • 5.1) Пункты в выбранном списке рассылки автоматически помещаются в соответствующие поля;
  • 5.2) Закончите тело письма;
  • 5.3) Проверьте как Отправить электронную почту через Outlook и Использовать настройки подписи Outlook коробки;
  • 5.4) Нажмите Отправить кнопка. Смотрите скриншот:

Теперь электронные письма отправляются. И подпись Outlook по умолчанию добавляется в конец тела письма.

  Если вы хотите получить бесплатную пробную версию (30-день) этой утилиты, пожалуйста, нажмите, чтобы загрузить это, а затем перейдите к применению операции в соответствии с указанными выше шагами.


Статьи по теме:

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

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

Отправить электронное письмо с несколькими вложениями в Excel
В этой статье рассказывается об отправке электронного письма через Outlook с несколькими вложениями, прикрепленными в Excel.

Отправить электронное письмо, если срок оплаты в Excel соблюден
Например, если срок оплаты в столбце C меньше или равен 7 дням (текущая дата - 2017/9/13), то отправьте электронное напоминание указанному получателю в столбце A с указанным содержанием в столбце B. Как сделать Добейся этого? В этой статье будет предоставлен метод VBA для более подробного решения этой проблемы.

Автоматически отправлять электронную почту на основе значения ячейки в Excel
Предположим, вы хотите отправить электронное письмо через Outlook определенному получателю на основе указанного значения ячейки в Excel. Например, если значение ячейки D7 на листе больше 200, электронное письмо создается автоматически. В этой статье представлен метод VBA, позволяющий быстро решить эту проблему.

Дополнительные руководства по рассылке писем в Excel ...


Лучшие инструменты для работы в офисе

Kutools for Excel решает большинство ваших проблем и увеличивает вашу производительность на 80%

  • Снова использовать: Быстро вставить сложные формулы, диаграммы и все, что вы использовали раньше; Зашифровать ячейки с паролем; Создать список рассылки и отправлять электронные письма ...
  • Бар Супер Формулы (легко редактировать несколько строк текста и формул); Макет для чтения (легко читать и редактировать большое количество ячеек); Вставить в отфильтрованный диапазон...
  • Объединить ячейки / строки / столбцы без потери данных; Разделить содержимое ячеек; Объединить повторяющиеся строки / столбцы... Предотвращение дублирования ячеек; Сравнить диапазоны...
  • Выберите Дубликат или Уникальный Ряды; Выбрать пустые строки (все ячейки пустые); Супер находка и нечеткая находка во многих рабочих тетрадях; Случайный выбор ...
  • Точная копия Несколько ячеек без изменения ссылки на формулу; Автоматическое создание ссылок на несколько листов; Вставить пули, Флажки и многое другое ...
  • Извлечь текст, Добавить текст, Удалить по позиции, Удалить пробел; Создание и печать промежуточных итогов по страницам; Преобразование содержимого ячеек в комментарии...
  • Суперфильтр (сохранять и применять схемы фильтров к другим листам); Расширенная сортировка по месяцам / неделям / дням, периодичности и др .; Специальный фильтр жирным, курсивом ...
  • Комбинируйте книги и рабочие листы; Объединить таблицы на основе ключевых столбцов; Разделить данные на несколько листов; Пакетное преобразование xls, xlsx и PDF...
  • Более 300 мощных функций. Поддерживает Office/Excel 2007-2021 и 365. Поддерживает все языки. Простое развертывание на вашем предприятии или в организации. Полнофункциональная 30-дневная бесплатная пробная версия. 60-дневная гарантия возврата денег.
вкладка kte 201905

Вкладка Office: интерфейс с вкладками в Office и упрощение работы

  • Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
  • Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
  • Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!
офисный дно
Сортировать комментарии по
Комментарии (27)
Оценок пока нет. Оцените первым!
Этот комментарий был сведен к минимуму модератором на сайте
большое спасибо, вы спасли мне жизнь с помощью этого шаблона :D
Этот комментарий был сведен к минимуму модератором на сайте
Дорогой Фавио,
Рад помочь.
Этот комментарий был сведен к минимуму модератором на сайте
не работает с вложениями в Office 2016
Этот комментарий был сведен к минимуму модератором на сайте
Дорогой Крис,
Приведенный ниже код VBA может вам помочь. После запуска кода выберите ячейки, содержащие адреса электронной почты, на которые вы будете отправлять электронные письма, а затем выберите файлы, которые необходимо прикрепить к электронному письму в качестве вложений, когда появится второе диалоговое окно. И подпись Outlook по умолчанию также будет отображаться в теле письма. Спасибо за ваш комментарий.

Sub SendEmailToAddressInCells()
Dim xRg как диапазон
Dim xRgEach как диапазон
Dim xRgVal как строка
Dim xAddress как строка
Dim xOutApp как Outlook.Application
Dim xMailOut как Outlook.MailItem
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Установите xRg = Application.InputBox("Пожалуйста, выберите диапазон адресов электронной почты", "KuTools For Excel", xAddress, , , , , 8)
Если xRg ничего не значит, выйдите из Sub
Приложение.ScreenUpdating = False
Установите xOutApp = CreateObject("Outlook.Application")
Установите xRg = xRg.SpecialCells (xlCellTypeConstants, xlTextValues)
Установите xFileDlg = Application.FileDialog (msoFileDialogFilePicker)
Если xFileDlg.Show = -1 Тогда
Для каждого xRgКаждый в xRg
xRgVal = xRgEach.Value
Если xRgVal Нравится "?*@?*.?*" Тогда
Установить xMailOut = xOutApp.CreateItem(olMailItem)
С xMailOut
.Отображать
.To = xRgVal
.Тема = "Тест"
.HTMLBody = "Это тестовая отправка электронной почты в Excel" & "
" & .HTMLBody
Для каждого xFileDlgItem в xFileDlg.SelectedItems
.Attachments.Add xFileDlgItem
Следующий xFileDlgItem
'.Отправлять
Конец с
End If
Далее
Установить xMailOut = Ничего
Установите xOutApp = Ничего
Application.ScreenUpdating = True
End If
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
я пытаюсь добавить подпись Outlook под названием «по умолчанию», но не может показаться, что это работает.
не могли бы вы помочь? Я считаю, что моя логика "xMailout" неверна. это моя предполагаемая неисправная область.

Private Sub CommandButton1_Click ()

Dim xOutApp как объект
Dim xOutMail как объект
Dim xMailBody как строка
Dim xMailOut как Outlook.MailItem
On Error Resume Next
Установите xOutApp = CreateObject("Outlook.Application")
Установите xOutMail = xOutApp.CreateItem(0)
xMailBody = "Приветствия:" & vbNewLine & vbNewLine & _
"Это строка 1" & vbNewLine & _
"Это строка 2" & vbNewLine & _
"Это строка 3" & vbNewLine & _
"Это линия 4"
On Error Resume Next
С xOutMail
.To = "Электронная почта.здесь.com"
.CC = "Электронная почта.здесь.com"
.Subject = "Заголовок электронной почты здесь - " & Range("Cell#").value
.Body = xMailBody
. Вложения.Добавить ActiveWorkbook.ПолноеИмя
Установить xMailOut = xOutApp.CreateItem(olMailItem)
С xMailOut
.Отображать
Конец с
ActiveWorkbook.Save
По ошибке GoTo 0
Установите xOutMail = Ничего
Установите xOutApp = Ничего
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Добрый день,
Ваш сценарий был изменен, пожалуйста, попробуйте. Спасибо.

Private Sub CommandButton1_Click ()
Dim xOutApp как объект
Dim xOutMail как объект
Dim xMailBody как строка
Dim xMailOut как Outlook.MailItem
On Error Resume Next
Установите xOutApp = CreateObject("Outlook.Application")
Установите xOutMail = xOutApp.CreateItem(0)
xMailBody = "Приветствия:" & vbNewLine & vbNewLine & _
"Это строка 1" & vbNewLine & _
"Это строка 2" & vbNewLine & _
"Это строка 3" & vbNewLine & _
"Это линия 4"
On Error Resume Next
С xOutMail
.To = "Электронная почта.здесь.com"
.CC = "Электронная почта.здесь.com"
.Subject = "Заголовок электронной почты здесь - " & Range("Cell#").Value
.Body = xMailBody
.Attachments.Add ActiveWorkbook.FullName
Установить xMailOut = xOutApp.CreateItem(olMailItem)
С xMailOut
.Отображать
Конец с
Конец с
ActiveWorkbook.Save
По ошибке GoTo 0
Установите xOutMail = Ничего
Установите xOutApp = Ничего
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
как добавить подпись, если макрос используется несколькими пользователями.
например, мой макрос будет выполняться еще тремя людьми. Итак, как макрос может использовать подпись пользователя, который запускает макрос.
заранее спасибо
Этот комментарий был сведен к минимуму модератором на сайте
Добрый день,
Код VBA может автоматически распознавать подпись по умолчанию в Outlook отправителя и отправлять электронную почту с его собственной подписью через Outlook.
Этот комментарий был сведен к минимуму модератором на сайте
Если мой основной текст связан с извлечением из полей Excel, использование & .HTMLBody в конце строки стирает весь основной текст и оставляет только подпись.
Этот комментарий был сведен к минимуму модератором на сайте
У меня возникли проблемы с запуском этого в Excel 2016. Я получаю сообщение «Ошибка компиляции: пользовательский тип не определен». Пожалуйста помоги!
Этот комментарий был сведен к минимуму модератором на сайте
Превосходно!!!!
Этот комментарий был сведен к минимуму модератором на сайте
Большое спасибо ...
Этот комментарий был сведен к минимуму модератором на сайте
Привет, мне нужна помощь с моим макросом, мне нужно вставить подпись Outlook под столом, не могли бы вы помочь мне с этим?

Private Sub CommandButton1_Click ()


Тусклая перспектива как объект
Dim newEmail как объект
Dim xInspect как объект
Dim pageEditor как объект

Установите Outlook = CreateObject("Outlook.Application")
Установите newEmail = Outlook.CreateItem(0)

С новой электронной почтой
.To = Лист5.Диапазон("F1")
.CC = ""
.BCC = ""
.Тема = Лист5.Диапазон("B5")
.Body = Sheet5.Range("B41")
.отображать

Установите xInspect = newEmail.GetInspector
Установить pageEditor = xInspect.WordEditor

Лист5.Диапазон("B6:I7").Копировать

pageEditor.Application.Selection.Start = Len(.Body)
pageEditor.Application.Selection.End = pageEditor.Application.Selection.Start
pageEditor.Application.Selection.PasteAndFormat (wdFormatPlainText)

.отображать
Установить pageEditor = Ничего
Установите xInspect = Ничего
Конец с

Установите новый адрес электронной почты = Ничего
Установить внешний вид = Ничего

End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Привет Бара,
Извините, не могу вам в этом помочь. Спасибо за ваш комментарий.
Этот комментарий был сведен к минимуму модератором на сайте
Уважаемые,
Может ли кто-нибудь помочь мне с моим VBA,
Мне нужна подпись в созданном письме:
Этот комментарий был сведен к минимуму модератором на сайте
Благодаря вам я могу добавить подпись сейчас, но тогда она удаляет пробелы между абзацами текста. Не могли ли вы помочь мне, пожалуйста ?


Саб привет мир ()
Dim OutApp как объект
Затемнить OutMail как объект
Затемнить ячейку как диапазон
Тусклый путь как строка
Путь = Application.ActiveWorkbook.Path
Установите OutApp = CreateObject("Outlook.Application")

Для каждой ячейки в диапазоне («C4: C6»)
Установить OutMail = OutApp.CreateItem(0)
С OutMail
.Отображать
.To = ячейка.Значение
.Subject = Cells(cell.Row, "D").Value
.HTMLBody = "Уважаемый" & Cells(cell.Row, "B").Value & "," _
& vbNewLine & vbNewLine & _
"Теплые приветствия" _
& vbNewLine & vbNewLine & _
«Мы, JK Overseas, хотели бы воспользоваться возможностью и представить нашу компанию JK Overseas, которая занимается соляным бизнесом последние 3 года. В настоящее время мы сильны на внутреннем рынке и расширяемся за рубежом. Мы являемся поставщиком пищевой соли, Соль для смягчения воды, Соль против обледенения, Промышленная соль" и "." _
& vbNewLine & vbNewLine & _
«У нас есть связи с крупными производителями в Индии, и мы закупаем у них качественную соль и экспортируем ее. Поэтому мы ищем надежного эксперта-импортера, а также агента-дистрибьютора для ведения долгосрочного бизнеса с взаимной выгодой». ." _
& vbNewLine & vbNewLine & _
«Пожалуйста, свяжитесь с нами по поводу вашего требования или по любым другим вопросам, которые могут у вас возникнуть. Мы обеспечиваем надежную логистику и своевременную доставку. Мы уверены, что наши цены, будучи наиболее конкурентоспособными, будут соответствовать вашим ожиданиям». _
& vbNewLine & vbNewLine & _
.HTMLBody

'.Отправлять
Конец с
Следующая ячейка
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Я пытаюсь интегрировать этот код в текущий формат, который у меня есть в настоящее время, благодаря чему я могу автоматизировать электронные письма в Excel на основе заданного диапазона значений. Любая помощь в отношении того, куда добавить код «подписи» в то, что у меня есть в настоящее время, будет очень признательна.

Общедоступная подпрограмма CheckAndSendMail()

'Обновлено Extendoffice 2018/11/22

Dim xRgDate как диапазон

Dim xRgSend As Range

Dim xRgText как диапазон

Dim xRgDone как диапазон

Dim xOutApp как объект

Dim xMailItem как объект

Dim xLastRow As Long

Dim vbCrLf как строка

Dim xMailBody как строка

Dim xRgDateVal как строка

Dim xRgSendVal как строка

Dim xMailSubject как строка

Дим я пока

On Error Resume Next

'Пожалуйста, укажите диапазон сроков выполнения

xStrRang = "D2:D110"

Установите xRgDate = диапазон (xStrRang)

'Пожалуйста, укажите диапазон адресов электронной почты получателей

xStrRang = "C2:C110"

Установите xRgSend = Диапазон (xStrRang)

xStrRang = "A2:A110"

Установите xRgName = Диапазон (xStrRang)

'Укажите диапазон с напоминаемым контентом в вашем письме

xStrRang = "Z2:Z110"

Установите xRgText = Диапазон (xStrRang)

xLastRow = xRgDate.Rows.Count

Установить xRgDate = xRgDate(1)

Установите xRgSend = xRgSend(1)

Установить xRgName = xRgName(1)

Установите xRgText = xRgText (1)

Установите xOutApp = CreateObject("Outlook.Application")

Для I = 1 Для xLastRow

xRgDateVal = ""

xRgDateVal = xRgDate.Offset(I - 1).Value

Если xRgDateVal <> "" Тогда

Если CDate(xRgDateVal) - Дата <= 30 И CDate(xRgDateVal) - Дата > 0 Тогда

xRgSendVal = xRgSend.Смещение (I - 1).Значение

xMailSubject = " Срок действия соглашения об обслуживании JBC истекает " & xRgDateVal

vbCrLf = "

"

xMailBody = ""

xMailBody = xMailBody & "Уважаемый" & xRgName.Offset(I - 1).Value & vbCrLf

xMailBody = xMailBody & " " & xRgText.Offset(I - 1).Value & vbCrLf

xMailBody = xMailBody & ""

Установить xMailItem = xOutApp.CreateItem(0)

С xMailItem

.Тема = xMailSubject

.To = xRgSendVal

.CC = "mailcc@justbettercare.com"

.HTMLBody = xMailBody

.Отображать

'.Отправлять

Конец с

Установить xMailItem = Ничего

End If

End If

Далее

Установите xOutApp = Ничего

End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Это действительно полезный код
Мне нужно изменить формат текста справа налево в строке xOutMsg
Помогите, пожалуйста .
Этот комментарий был сведен к минимуму модератором на сайте
Я пытаюсь отправить отдельные листы из Excel на разные электронные письма, но он прикрепит только саму книгу. Кроме того, нужно иметь возможность добавить свою строку подписи. Любая помощь? Sub AST_Email_From_Excel()

Dim emailApplication As Object
Dim emailItem As Object

Установить emailApplication = CreateObject("Outlook.Application")
Установить элемент электронной почты = приложение электронной почты.CreateItem(0)

«Теперь мы создаем электронную почту.

emailItem.to = Диапазон ("e2"). Значение

emailItem.CC = Диапазон ("g2"). Значение

emailItem.Subject = "Невозвращенное техническое оборудование"

emailItem.Body = "В прикрепленной таблице указаны невозвращенные товары в вашем районе"

'Прикрепить текущую книгу
emailItem.Attachments.Add ActiveWorkbook.FullName

'Прикрепите любой файл с вашего компьютера.
'emailItem.Attachments.Add ("C:\...)"

'Отправить письмо
'emailItem.send

'Отображать электронное письмо, чтобы пользователь мог изменить его по желанию перед отправкой
emailItem.Display

Установить emailItem = Ничего
Установить emailApplication = Ничего

End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Привет Крис, Код, который вы предоставили, был изменен. Теперь подпись Outlook можно вставить в тело сообщения. Пожалуйста, попробуйте. Спасибо. Подпрограмма AST_Email_From_Excel()
'Обновлено Extendoffice 20220211
Dim emailApplication As Object
Dim emailItem As Object
Установить emailApplication = CreateObject("Outlook.Application")
Установить элемент электронной почты = приложение электронной почты.CreateItem(0)

«Теперь мы создаем электронную почту.
emailItem.Display 'Показать электронное письмо, чтобы пользователь мог изменить его по желанию перед отправкой
emailItem.to = Диапазон ("e2"). Значение
emailItem.CC = Диапазон ("g2"). Значение
emailItem.Subject = "Невозвращенное техническое оборудование"
emailItem.HTMLBody = "В прикрепленной таблице указаны невозвращенные товары в вашем районе" & " " & emailItem.HTMLBody

'Прикрепить текущую книгу
emailItem.Attachments.Add ActiveWorkbook.FullName

Установить emailItem = Ничего
Установить emailApplication = Ничего

End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Кристал! Спасибо, что заставили добавить подпись, хотя, похоже, не нравится раздел HTMLBody. Когда я запускаю макрос, он отлаживает emailItem. " " & emailItem.HTMLBodyand не дополняет остальное.  
Этот комментарий был сведен к минимуму модератором на сайте
Здравствуйте,
Какую версию Excel вы используете? Следующий код VBA также может помочь. Пожалуйста, попробуйте. Спасибо за ваш отзыв. Sub SendWorkSheet ()
'Обновить Extendoffice 20220218
Развернуть xFile как строку
Dim xFormat As Long
Dim Wb как рабочая книга
Dim Wb2 как рабочая тетрадь
Dim FilePath как строка
Dim FileName As String
Dim OutlookApp как объект
Dim OutlookMail как объект
On Error Resume Next
Приложение.ScreenUpdating = False
Установите Wb = Application.ActiveWorkbook
ActiveSheet.Копировать
Установите Wb2 = Application.ActiveWorkbook
Выберите регистр Wb.FileFormat.
Случай xlOpenXMLWorkbook:
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
Случай xlOpenXMLWorkbookMacroEnabled:
Если Wb2.HasVBProject, то
xFile = ".xlsm"
xFormat = xlOpenXMLWorkbookMacroEnabled
Еще
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
End If
Случай Excel8:
xFile = ".xls"
хФормат = Excel8
Случай xlExcel12:
xFile = ".xlsb"
хФормат = кслExcel12
End Select
FilePath = Environ $ ("temp") & "\"
FileName = Wb.Name & Format (теперь "дд-ммм-гг ч-мм-сс")
Установите OutlookApp = CreateObject ("Outlook.Application")
Установите OutlookMail = OutlookApp.CreateItem (0)
Wb2.SaveAs FilePath & FileName & xFile, FileFormat: = xFormat
'xstr = диапазон ("e2") & ";" & диапазон ("g2")
С OutlookMail
.Отображать
.To = Диапазон ("e2")
.CC = Диапазон ("g2")
.BCC = ""
.Subject = "Невозвращенное техническое оборудование"
.HTMLBody = "См. прилагаемую таблицу невозвращенных товаров в вашем регионе" & " " & .HTMLBody
.Attachments.Add Wb2.FullName
'.Отправлять
Конец с
Wb2.Закрыть
Убить FilePath & FileName & xFile
Установите OutlookMail = Nothing
Установите OutlookApp = Nothing
Application.ScreenUpdating = True
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Похоже, это Excel 2016 и VBA 7.1.
Этот комментарий был сведен к минимуму модератором на сайте
Oi Cristal, небольшой макрос, который позволяет настроить электронную почту, используя изображения и формат в оригинальном формате. Резолвер Como consigo?

Sub Geraremail ()

Dim OLapp как Outlook.Application
Dim janela As Outlook.MailItem

Установите OLapp = Новый Outlook.Application
Установить janela = OLapp.CreateItem(olMailItem)

Arquivo01 = "Мапа АН"
Anexo01 = ThisWorkbook.Path & "\" & Arquivo01 & ".xlsm"


С Джанелой
ActiveWorkbook.Save
.Отображать
.To = Листы ("Основа"). Диапазон ("A2"). Значение
.CC = Листы ("Основа"). Диапазон ("A5"). Значение
.Subject = "Mapa - Acrilo" & Format(Date, "dd.mm.yy")
assinatura = .тело
.Body = "Prezados/as," & Chr(10) & Chr(10) & "Segue anexo o mapa de Acrilonitrila рассматривается как vendas previstas no S&OP." & Chr(10) & Chr(10) & assinatura
.Вложения.Добавить Anexo01
Конец с

End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Com а Mudança abaixo, consegui ajustar. Запишитесь на письмо, написанное на английском языке в Times New Roman. Gostaria de usar Calibri, como posso alterar o código?

Sub Geraremail ()

Dim OLapp как Outlook.Application
Dim janela As Outlook.MailItem

Установите OLapp = Новый Outlook.Application
Установить janela = OLapp.CreateItem(olMailItem)

Arquivo01 = "Мапа АН"
Anexo01 = ThisWorkbook.Path & "\" & Arquivo01 & ".xlsm"


С Джанелой
ActiveWorkbook.Save
.Отображать
.To = Листы ("Основа"). Диапазон ("A2"). Значение
.CC = Листы ("Основа"). Диапазон ("A5"). Значение
.Subject = "Mapa - Acrilo" & Format(Date, "dd.mm.yy")
assinatura = .тело
.HTMLBody = "Prezados/as," & Chr(10) & Chr(10) & "Segue anexo o mapa de Acrilonitrila рассматривается как продаваемый предварительно без S&OP." & " " & .HTMLBody
.Вложения.Добавить Anexo01
Конец с

End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Привет Милла,
Следующий код VBA может помочь вам изменить шрифт тела электронной почты на Calibri, попробуйте. Спасибо.
Перед запуском кода нужно нажать Инструменты > Справка в Microsoft Visual Basic для приложений окно, а затем проверьте Библиотека объектов Microsoft Word флажок в Ссылки - VBAProject диалоговое окно, как показано на снимке экрана ниже.
[img]I:\工作\周雪明\2022年工作\6月份\文章评论截图\3.png[/img]
Sub Geraremail()
Dim OLapp As Outlook.Application
Dim janela As Outlook.MailItem
Dim xDoc As Document 'Click Tools > Reference to enable the Microsoft Word Object Library
On Error Resume Next
Set OLapp = New Outlook.Application
Set janela = OLapp.CreateItem(olMailItem)
Arquivo01 = "Mapa AN"
Anexo01 = ThisWorkbook.Path & "\" & Arquivo01 & ".xlsm"
With janela
  ActiveWorkbook.Save
  .Display
  .To = Sheets("Base").Range("A2").Value
  .CC = Sheets("Base").Range("A5").Value
  .Subject = "Mapa - Acrilo " & Format(Date, "dd.mm.yy")
   assinatura = .Body
  .HTMLBody = "Prezados/as," & Chr(10) & Chr(10) & "Segue anexo o mapa de Acrilonitrila considerando as vendas previstas no S&OP." & "<br>" & .HTMLBody
  .Attachments.Add Anexo01
End With
Set xDoc = janela.GetInspector.WordEditor
xDoc.Content.Font.Name = "Calibri"
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Привет Милла,
Следующий код VBA может помочь вам изменить шрифт тела электронной почты на Calibri, попробуйте. Спасибо.
Перед запуском кода нужно нажать Инструменты > Справка в Microsoft Visual Basic для приложений окно, а затем проверьте Библиотека объектов Microsoft Word флажок в Ссылки - VBAProject диалоговое окно в виде прикрепленного файла, показанного ниже.
Sub Geraremail()
Dim OLapp As Outlook.Application
Dim janela As Outlook.MailItem
Dim xDoc As Document 'Click Tools > Reference to enable the Microsoft Word Object Library
On Error Resume Next
Set OLapp = New Outlook.Application
Set janela = OLapp.CreateItem(olMailItem)
Arquivo01 = "Mapa AN"
Anexo01 = ThisWorkbook.Path & "\" & Arquivo01 & ".xlsm"
With janela
  ActiveWorkbook.Save
  .Display
  .To = Sheets("Base").Range("A2").Value
  .CC = Sheets("Base").Range("A5").Value
  .Subject = "Mapa - Acrilo " & Format(Date, "dd.mm.yy")
   assinatura = .Body
  .HTMLBody = "Prezados/as," & Chr(10) & Chr(10) & "Segue anexo o mapa de Acrilonitrila considerando as vendas previstas no S&OP." & "<br>" & .HTMLBody
  .Attachments.Add Anexo01
End With
Set xDoc = janela.GetInspector.WordEditor
xDoc.Content.Font.Name = "Calibri"
End Sub
Здесь еще нет комментариев
Оставляйте свои комментарии
Публикация как гость
×
Оценить этот пост:
0   Характеристики
Предлагаемые места

Подписывайтесь на Нас

Copyright © 2009 - www.extendoffice.ком. | Все права защищены. Питаться от ExtendOffice, | Карта сайта
Microsoft и логотип Office являются товарными знаками или зарегистрированными товарными знаками Microsoft Corporation в США и / или других странах.
Защищено Sectigo SSL