Страницы: 1
RSS
Сцепка диапазонов Excel и вставка в письмо
 
Добрый день.
Имеется простенький макрос:
из таблицы в экселе последовательно перебираются строки, по каждой формируется письмо: текст+ файл во вложении + таблица из файла. Таблица стандартная - шапка и значения. При объединении строк между ними образуется пробел, который не получается убрать в коде.
В чем проблема?
Код
Sub cards_send()Application.DisplayAlerts = False
Application.ScreenUpdating = False
'пер-е/конст сист
Dim Mail_Object, Mail_Single As Variant
Dim my_date As String, puthtm As String, n As String, my_date_papk As String, my_park_papk As String, my_date_file As String, putfile As String, my_date_send As String, SigString As String
Dim book1 As Workbook
Dim x As String
 
For i = 4 To 12
puthtm = "C:\Users\Анастасия\Documents\tech\file.htm"
 
Set Mail_Object = CreateObject("Outlook.Application") 'запускаем Outlook в скрытом режиме, если не запустился - выходим
 
putfile = ThisWorkbook.Worksheets(3).Cells(i, 10).Value
my_date = ThisWorkbook.Worksheets(3).Cells(i, 1).Value
ThisWorkbook.Worksheets(3).Cells(i, 2).Interior.Color = vbYellow
 
x = "$C$" & i & ":$I$" & i
If Len(Dir(putfile)) = 0 Then
   MsgBox "Такого файла нет. Проверьте дату ввода; имя файла; путь файла"
   Application.DisplayAlerts = True
Exit Sub
End If
Set book1 = Application.Workbooks.Open(putfile)
 
Set Mail_Single = Mail_Object.CreateItem(0)
 
Mail_Single.To = ThisWorkbook.Worksheets(3).Cells(i, 11).Value
Mail_Single.Subject = "Премирование | Оценка эффективности деятельности за 2019 год "
Mail_Single.attachments.Add (putfile)
Mail_Single.CC = "  <Olga@so.ru>;  "
 
 
'body письма
Mail_Single.display
SigString = Mail_Single.HTMLbody
Mail_Single.HTMLbody = "<p style='font-family:times;font-size:11pt;font color:#1f497d'> " + my_date + ", добрый день!<br>по итогам Вашей работы  <b><font color='#E81510'>за 2019 год</font></b> была осуществлена оценка эффективности деятельности на основе карты целей. <br>Выплата второй части годовой премии с учетом Ваших оценок по карте целей - 27 марта 2020 г. <br><br> <u>Этапы проведения оценки: </u><br> 1.  Расчет количественных показателей центрами компетенций<br>2.  Согласование коэффициентов руководителем<br> <br><b><font color='#E81510'>Итоговые коэффициенты:</font></p>" _
& RangetoHTML(puthtm, "Лист4", Application.ThisWorkbook.Worksheets("Лист4").Range("c1:i3").Address, Application.ThisWorkbook) _
& RangetoHTML(puthtm, "Лист4", x, Application.ThisWorkbook) & "<p style='font-family:times;font-size:11pt;font color:#1f497d'>Во вложении итоговые формы оценки по карте целей за 2019 год. <br> Успехов и продуктивной работы! </p>" + SigString
 
Set Mail_Single = Nothing
Set Mail_Object = Nothing
 
If Dir(puthtm) <> "" Then
Kill (puthtm) 'удаляем ранее созданный временный htm
End If
 
book1.Close
 
Next i
 
 
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
 
 
'пер-е: путь временого файла,имя листа,область коп-я,из какой книги
Function RangetoHTML(puthtm As String, n As String, t As String, actwbk As Object)
'создание html файла для вложения таблицы в тело и непосредственно само вложение
With actwbk.PublishObjects.Add(SourceType:=xlSourceRange, _
Filename:=puthtm, _
Sheet:=n, _
Source:=t, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
Dim TempFile As String
Dim TempWB As Workbook
Dim fso As Object
Dim ts As Object
TempFile = "C:\Users\Анастасия\Documents\tech\file.htm" 'это путь куда создаётся временный htm
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center", "align=left")
End Function
 
Добрый день.
Нужен образец результата объединения строк с указанием пробела (пробелов), который не получается убрать в коде.
Удивление есть начало познания © Surprise me!
И да пребудет с нами сила ВПР.
 
Образец в картинке первого поста. В тексте тут таблица не проходит.
 
Ок. И где "в картинке первого поста" лишний пробел?
Удивление есть начало познания © Surprise me!
И да пребудет с нами сила ВПР.
 
Наверное неправильно выразилась: разрыв между строками в таблице, пробел между ними.
С самими данными в ячейках все ок.
 
Что такое "разрыв между строками в таблице"?! Покажите это в файле/скриншоте/тексте/где-нибудь.
Удивление есть начало познания © Surprise me!
И да пребудет с нами сила ВПР.
 
Предположу, что это разрыв не между строками, а между разными таблицами, которые по факту вставляются в тело письма.
По вопросам из тем форума, личку не читаю.
 
Ну видно же на скрине что шапка и строка разделены между собой.


Да,  получается меджу разными таблицами. Есть вариант как-то это исправить?
 
Могу предположить что в
Mail_Single.HTMLbody =
для заголовка удалить в конце из результата функции  RangetoHTML последний тег
а в следующем наоборот, первый тег .
По вопросам из тем форума, личку не читаю.
Страницы: 1
Наверх