Домашняя страница Undo Do Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Макрос на вставку текста и таблицы из Excel в письмо Outlook - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Excel и другие приложения » Outlook » Макрос на вставку текста и таблицы из Excel в письмо Outlook (RangetoHTML - function not defined)
Макрос на вставку текста и таблицы из Excel в письмо Outlook
Slym1349 Дата: Пятница, 09.08.2019, 12:27 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 13
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Доброго времени суток, уважаемые форумчане! yes

Сразу попрошу - не спешите удалять тему :D

Подобный вопрос достаточно частый, и прежде чем создавать тему я перелопатил макрос моего предшественника (который пытаюсь починить)
и прочитал вот эти темы:

Не вставляет таблицу из Excel в тело письма
Макрос на отправку формы (нескольким адресатам)через Outlook
Mail Range/Selection in the body of the mail

Вобщем-то все красиво и понятно, НО!

При запуске макроса выделяет RangetoHTML в строке
[vba]
Код
.HTMLBody = RangetoHTML(rngg)
[/vba]
и выдает сообщение "Compile error: Sub or function not defined"

Макрос мой предшественник буквально скопировал из третей темы, но код все же прикладываю:

[vba]
Код
Sub Send_letter()
'Понимаем, кто делает отчет

Dim iName As String
iName = Environ("UserName")

Sheets("Users").Select
Range("B1").Select
Range("B1") = iName

Calculate
'ДЛЯ ПЕРВОГО ПИСЬМА
Sheets("Letter 1").Select

'Находим последнюю строчку
Range("A8").Select
Selection.End(xlDown).Select
a = Selection.Row
b = "A" & (a + 2)

'Копируем нижнюю часть письма
Range("I4:I16").Select
Selection.Copy
Range(b).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'Range для тела письма
c = "A4:G" & (a + 15)

'Range для адресантов Main
Sheets("Users").Select
Range("F3").Select
Selection.End(xlDown).Select
d = Selection.Row
e = ""
For N = 4 To d
    e = e + Range("F" & N).Text + ";"
Next N

'Range для адресантов Copy
Range("H3").Select
Selection.End(xlDown).Select
f = Selection.Row
g = ""
For N = 4 To f
    g = g + Range("H" & N).Text + ";"
Next N
Sheets("Letter 1").Select

' Создание первого письма
    Dim rngg As Range
    Dim OutApp As Object
    Dim OutMail As Object

    Set rngg = Nothing
    On Error Resume Next
    'Only the visible cells in the selection
    Set rngg = ActiveWorkbook.Worksheets("Letter 1").Range(c)
    'You can also use a fixed range if you want
    'Set rng = Sheets("YourSheet").Range("D4:D12").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

  If rngg Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protected" & _
               vbNewLine & "please correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

' указание папки откуда берутся вкладываемые файлы
    MyFolderM = "C:\путь                 ' МЕНЯЕТСЯ"
    MyFileM = Dir(MyFolderM & "\*.pdf")
    MyFolder = "C:\путь"                   ' МЕНЯЕТСЯ
    MyFile = Dir(MyFolder & "\*.pdf")
    
    On Error Resume Next
    With OutMail
        .To = e
        .CC = g
        .BCC = ""
        .Subject = ActiveWorkbook.Worksheets("Letter 1").Range("A3")
        .HTMLBody = RangetoHTML(rngg)  'HTMLBody
        .Attachments.Add (MyFolderM & "\" & MyFileM)
        Do While MyFile <> ""
            .Attachments.Add (MyFolder & "\" & MyFile)
            MyFile = Dir
        Loop
      '  .Attachments.Add "\\BETTA\Deals.xlsx"
        .Display   'or use .Display use .Send
    End With
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing

' Удаляем нижную часть для следующего дня
Sheets("Letter 1").Select
d = "A" & (a + 2) & ":A" & (a + 14)
Range(d).Select
Selection.ClearContents
Range("B1").Select

End Sub
[/vba]

Прикладываю также сам файл т.к. адресаты и текст внесены в Excel несколько замысловато.

Пробовал в Set rngg ссылаться на конкретный диапазон с текстом, менял (на всякий случай) rngg на rng - не помогло, но как я понял проблема в том что excel не определяет функцию
RangetoHTML и где-то нужно поставить "заветную галочку"...

Подскажите пожалуйста - где ошибка deal :)

[p.s.] файл Excel приложу вечером - на работе отсутствует такая возможность


Сообщение отредактировал Slym1349 - Пятница, 09.08.2019, 12:30
 
Ответить
СообщениеДоброго времени суток, уважаемые форумчане! yes

Сразу попрошу - не спешите удалять тему :D

Подобный вопрос достаточно частый, и прежде чем создавать тему я перелопатил макрос моего предшественника (который пытаюсь починить)
и прочитал вот эти темы:

Не вставляет таблицу из Excel в тело письма
Макрос на отправку формы (нескольким адресатам)через Outlook
Mail Range/Selection in the body of the mail

Вобщем-то все красиво и понятно, НО!

При запуске макроса выделяет RangetoHTML в строке
[vba]
Код
.HTMLBody = RangetoHTML(rngg)
[/vba]
и выдает сообщение "Compile error: Sub or function not defined"

Макрос мой предшественник буквально скопировал из третей темы, но код все же прикладываю:

[vba]
Код
Sub Send_letter()
'Понимаем, кто делает отчет

Dim iName As String
iName = Environ("UserName")

Sheets("Users").Select
Range("B1").Select
Range("B1") = iName

Calculate
'ДЛЯ ПЕРВОГО ПИСЬМА
Sheets("Letter 1").Select

'Находим последнюю строчку
Range("A8").Select
Selection.End(xlDown).Select
a = Selection.Row
b = "A" & (a + 2)

'Копируем нижнюю часть письма
Range("I4:I16").Select
Selection.Copy
Range(b).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'Range для тела письма
c = "A4:G" & (a + 15)

'Range для адресантов Main
Sheets("Users").Select
Range("F3").Select
Selection.End(xlDown).Select
d = Selection.Row
e = ""
For N = 4 To d
    e = e + Range("F" & N).Text + ";"
Next N

'Range для адресантов Copy
Range("H3").Select
Selection.End(xlDown).Select
f = Selection.Row
g = ""
For N = 4 To f
    g = g + Range("H" & N).Text + ";"
Next N
Sheets("Letter 1").Select

' Создание первого письма
    Dim rngg As Range
    Dim OutApp As Object
    Dim OutMail As Object

    Set rngg = Nothing
    On Error Resume Next
    'Only the visible cells in the selection
    Set rngg = ActiveWorkbook.Worksheets("Letter 1").Range(c)
    'You can also use a fixed range if you want
    'Set rng = Sheets("YourSheet").Range("D4:D12").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

  If rngg Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protected" & _
               vbNewLine & "please correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

' указание папки откуда берутся вкладываемые файлы
    MyFolderM = "C:\путь                 ' МЕНЯЕТСЯ"
    MyFileM = Dir(MyFolderM & "\*.pdf")
    MyFolder = "C:\путь"                   ' МЕНЯЕТСЯ
    MyFile = Dir(MyFolder & "\*.pdf")
    
    On Error Resume Next
    With OutMail
        .To = e
        .CC = g
        .BCC = ""
        .Subject = ActiveWorkbook.Worksheets("Letter 1").Range("A3")
        .HTMLBody = RangetoHTML(rngg)  'HTMLBody
        .Attachments.Add (MyFolderM & "\" & MyFileM)
        Do While MyFile <> ""
            .Attachments.Add (MyFolder & "\" & MyFile)
            MyFile = Dir
        Loop
      '  .Attachments.Add "\\BETTA\Deals.xlsx"
        .Display   'or use .Display use .Send
    End With
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing

' Удаляем нижную часть для следующего дня
Sheets("Letter 1").Select
d = "A" & (a + 2) & ":A" & (a + 14)
Range(d).Select
Selection.ClearContents
Range("B1").Select

End Sub
[/vba]

Прикладываю также сам файл т.к. адресаты и текст внесены в Excel несколько замысловато.

Пробовал в Set rngg ссылаться на конкретный диапазон с текстом, менял (на всякий случай) rngg на rng - не помогло, но как я понял проблема в том что excel не определяет функцию
RangetoHTML и где-то нужно поставить "заветную галочку"...

Подскажите пожалуйста - где ошибка deal :)

[p.s.] файл Excel приложу вечером - на работе отсутствует такая возможность

Автор - Slym1349
Дата добавления - 09.08.2019 в 12:27
_Boroda_ Дата: Пятница, 09.08.2019, 13:10 | Сообщение № 2
Группа: Модераторы
Ранг: Местный житель
Сообщений: 15567
Репутация: 6074 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
В третьей ссылке ниже самого макроса есть еще код для функции Function RangetoHTML(rng As Range)
Вы его себе забрали?


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеВ третьей ссылке ниже самого макроса есть еще код для функции Function RangetoHTML(rng As Range)
Вы его себе забрали?

Автор - _Boroda_
Дата добавления - 09.08.2019 в 13:10
Slym1349 Дата: Пятница, 09.08.2019, 14:42 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 13
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
_Boroda_, огромное, человеческое спасибо!!!! hands hands hands

На всякий случай поясню для тех кто придет в поисках ответов в эту тему - добавил под написанный выше макрос функцию из третьей ссылки, без каких либо изменений - и все заработало!!!
 
Ответить
Сообщение_Boroda_, огромное, человеческое спасибо!!!! hands hands hands

На всякий случай поясню для тех кто придет в поисках ответов в эту тему - добавил под написанный выше макрос функцию из третьей ссылки, без каких либо изменений - и все заработало!!!

Автор - Slym1349
Дата добавления - 09.08.2019 в 14:42
Slym1349 Дата: Пятница, 09.08.2019, 18:26 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 13
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
_Boroda_, а такой вопрос - после радостного сохранения и закрытия файла с макросами он перестал запускаться - Excel прекращает работу.

Подробности ошибки:

Цитата
Сигнатура проблемы:
Имя события проблемы: APPCRASH
Имя приложения: EXCEL.EXE
Версия приложения: 16.0.4873.1000
Отметка времени приложения: 5cffdd4f
Имя модуля с ошибкой: VBE7.DLL
Версия модуля с ошибкой: 7.1.10.56
Отметка времени модуля с ошибкой: 57e9c547
Код исключения: c0000005
Смещение исключения: 00000000000e35a1
Версия ОС: 6.1.7601.2.1.0.256.48
Код языка: 1049

Дополнительные сведения об этой проблеме:
LCID: 1049
skulcid: 1049

Ознакомьтесь с заявлением о конфиденциальности в Интернете:
http://go.microsoft.com/fwlink/?linkid=104288&clcid=0x0419

Если заявление о конфиденциальности в Интернете недоступно, ознакомьтесь с его локальным вариантом:
C:\Windows\system32\ru-RU\erofflps.txt

Соответственно вопрос - как открыть файл? :D
Или как хотя бы из него вытащить макросы? yes
 
Ответить
Сообщение_Boroda_, а такой вопрос - после радостного сохранения и закрытия файла с макросами он перестал запускаться - Excel прекращает работу.

Подробности ошибки:

Цитата
Сигнатура проблемы:
Имя события проблемы: APPCRASH
Имя приложения: EXCEL.EXE
Версия приложения: 16.0.4873.1000
Отметка времени приложения: 5cffdd4f
Имя модуля с ошибкой: VBE7.DLL
Версия модуля с ошибкой: 7.1.10.56
Отметка времени модуля с ошибкой: 57e9c547
Код исключения: c0000005
Смещение исключения: 00000000000e35a1
Версия ОС: 6.1.7601.2.1.0.256.48
Код языка: 1049

Дополнительные сведения об этой проблеме:
LCID: 1049
skulcid: 1049

Ознакомьтесь с заявлением о конфиденциальности в Интернете:
http://go.microsoft.com/fwlink/?linkid=104288&clcid=0x0419

Если заявление о конфиденциальности в Интернете недоступно, ознакомьтесь с его локальным вариантом:
C:\Windows\system32\ru-RU\erofflps.txt

Соответственно вопрос - как открыть файл? :D
Или как хотя бы из него вытащить макросы? yes

Автор - Slym1349
Дата добавления - 09.08.2019 в 18:26
Pelena Дата: Суббота, 10.08.2019, 07:27 | Сообщение № 5
Группа: Админы
Ранг: Местный житель
Сообщений: 14320
Репутация: 3131 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
Попробуйте запустить с отключенными макросами


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеПопробуйте запустить с отключенными макросами

Автор - Pelena
Дата добавления - 10.08.2019 в 07:27
Slym1349 Дата: Суббота, 10.08.2019, 13:48 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 13
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Pelena, спасибо за наводку - я так понял Вы имеет ввиду - Параметры - Центр управления безопасностью - Параметры макросов - отключить все макросы без уведомления(/с уведомлением) - ?
На домашнюю не было возможности скинуть тот файл и проверить данный способ, буду пробовать в понедельник.

P.S. поскольку не могу редактировать первое сообщение, то Excel файл из которого формируется письмо прикладываю здесь.
К сообщению приложен файл: example.xlsm(20.9 Kb)
 
Ответить
СообщениеPelena, спасибо за наводку - я так понял Вы имеет ввиду - Параметры - Центр управления безопасностью - Параметры макросов - отключить все макросы без уведомления(/с уведомлением) - ?
На домашнюю не было возможности скинуть тот файл и проверить данный способ, буду пробовать в понедельник.

P.S. поскольку не могу редактировать первое сообщение, то Excel файл из которого формируется письмо прикладываю здесь.

Автор - Slym1349
Дата добавления - 10.08.2019 в 13:48
Мир MS Excel » Вопросы и решения » Excel и другие приложения » Outlook » Макрос на вставку текста и таблицы из Excel в письмо Outlook (RangetoHTML - function not defined)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2019 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!