Я пытаюсь отправить определенные разделы файла excel в тело почты Outlook.Как отправить данные Excel (несколько отдельных диапазонов), разделенных возвратом каретки в почтовый ящик Outlook
Мне нужно форматирование данных, поскольку я работаю с данными внутри таблиц и с разными цветами заполнения ячеек и цветами шрифта, поэтому его нельзя хранить в строке AFAIK.
Мне нужно, чтобы кадры возвращались для разделения таблиц, вставленных в Outlook, чтобы другой текст можно было вручную добавить в тело электронной почты между таблицами, не искажая форматирование таблицы.
Код ниже показывает, что нужно делать, но не работает, поскольку возвращает ошибку времени выполнения 13, не соответствует раскладке на строке «.HTMLBody». Я потратил много времени на различные способы сделать это, но так я должен работать, я просто не знаю, какие типы данных использовать и как правильно это делать.
Имейте в виду, что в обоих примерах моего кода ниже я вырезал большую часть области ввода данных, потому что это был бы избыточный код.
Sub sendToOutlook()
Dim OutApp As Object
Dim OutMail As Object
Dim bodyFieldA As Range
Dim bodyFieldB As Range
On Error Resume Next
Set OutApp = GetObject(, "Outlook.Application")
If Err <> 0 Then Set OutApp = CreateObject("Outlook.Application")
On Error GoTo 0
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = Range("L18").Value
.CC = Range("L19").Value
.BCC = Range("L20").Value
.Subject = Range("L1") & " " & Range("N1").Text _
& " " & Range("O1") & " " & Range("R1").Text _
& " " & Range("S1")
Set bodyFieldA = Range("A26:I33")
Set bodyFieldB = Range("A34:I34")
.HTMLBody = bodyFieldA + vbCrLf + bodyFieldB + "<HTML><body><body></HTML>"
.display
End With
Application.CutCopyMode = False
Range("A1").Select
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Моя старая версия работает только тогда, когда прогноз уже был дан фокус, пользователь один раз, в противном случае «SendKeys», которые я использую вместо возврата каретки посылаются, чтобы преуспеть вместо этого, разрушая данные рабочего листа.
Кроме того, если поле «.TO» оставлено пустым, вместо «тела электронной почты» отправляются «sendkeys».
Мне нужно исправить эту проблему, поэтому приведенный выше код является моей попыткой решения для него, а код ниже - это мой старый код, который выполняет эту работу, но с большим количеством работы с Band-Aid и проблемами с менее опытными пользователями которые будут использовать макрос, не смогут справиться.
Sub sendToOutlook()
Dim OutApp As Object
Dim OutMail As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object
On Error Resume Next
Set OutApp = GetObject(, "Outlook.Application")
If Err <> 0 Then Set OutApp = CreateObject("Outlook.Application")
On Error GoTo 0
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = Range("L18").Value
.CC = Range("L19").Value
.BCC = Range("L20").Value
.Subject = _
Range("L1") & " " & Range("N1").Text _
& " " & Range("O1") & " " & Range("R1").Text _
& " " & Range("S1")
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range
'force html format
.HTMLBody = "<HTML><body><body></HTML>"
.display
oRng.collapse 1
Range("A26:I33").Select
Selection.Copy
oRng.Paste
SendKeys "{ENTER}", True
oRng.collapse 1
Range("A34:I34").Select
Selection.Copy
oRng.Paste
SendKeys "{ENTER}", True
End With
'deselect cell range
Application.CutCopyMode = False
Range("A1").Select
Set OutMail = Nothing
Set OutApp = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
End Sub
Я попытался с помощью: "oRng = ORng & Chr (13)" ... Тем не менее, Chr (13) остается внутри таблиц, которая губит их форматирование размера, и не расщепляется таблицы. – Wafer