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

Вход

Регистрация

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

 

= Мир MS Excel/Макрос по отправке файла на почту - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос по отправке файла на почту (Макросы/Sub)
Макрос по отправке файла на почту
Controler Дата: Понедельник, 21.03.2016, 02:47 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
Назначил на кнопку макрос по отправке файла на почту, письмо с вложением файла формируется и отправляется, но ни как не могу чтобы в письме был мой текст, выдается ошибка.
1.Как добавить подпись письма?
2.Что нужно дописать чтобы отправлялась только последняя заполненная строка?

[vba]
Код
Sub Перенос()
    With ThisWorkbook.Sheets("Отчет за сутки")
        .Range("A2:j" & .Cells(.Rows.Count, 1).End(xlUp).Row).SpecialCells(2).Copy Sheets("Отчет за 2016 г.").Range("A" & Rows.Count).End(xlUp)(2)
        .Copy
    With ActiveWorkbook
        .SendMail Recipients:=Array("пупкин@mail.ru", "васичкин@mail.ru"), Subject:="Статистика"
        .Close SaveChanges:=False
    End With
    If ThisWorkbook.Saved = False Then
    ThisWorkbook.Save
    End If
    Application.Quit
    Sheets("Отчет за сутки").Range("A2:j" & .Cells(.Rows.Count, 1).End(xlUp).Row).ClearContents
    MsgBox ("Внесено в отчет за 2016 год, отправлено Пупкину и Васичкину!")
End Sub
[/vba]
К сообщению приложен файл: 1251205.xls (83.5 Kb)
 
Ответить
СообщениеНазначил на кнопку макрос по отправке файла на почту, письмо с вложением файла формируется и отправляется, но ни как не могу чтобы в письме был мой текст, выдается ошибка.
1.Как добавить подпись письма?
2.Что нужно дописать чтобы отправлялась только последняя заполненная строка?

[vba]
Код
Sub Перенос()
    With ThisWorkbook.Sheets("Отчет за сутки")
        .Range("A2:j" & .Cells(.Rows.Count, 1).End(xlUp).Row).SpecialCells(2).Copy Sheets("Отчет за 2016 г.").Range("A" & Rows.Count).End(xlUp)(2)
        .Copy
    With ActiveWorkbook
        .SendMail Recipients:=Array("пупкин@mail.ru", "васичкин@mail.ru"), Subject:="Статистика"
        .Close SaveChanges:=False
    End With
    If ThisWorkbook.Saved = False Then
    ThisWorkbook.Save
    End If
    Application.Quit
    Sheets("Отчет за сутки").Range("A2:j" & .Cells(.Rows.Count, 1).End(xlUp).Row).ClearContents
    MsgBox ("Внесено в отчет за 2016 год, отправлено Пупкину и Васичкину!")
End Sub
[/vba]

Автор - Controler
Дата добавления - 21.03.2016 в 02:47
krosav4ig Дата: Понедельник, 21.03.2016, 04:25 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 2346
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениессылка номер раз
ссылка номер два

Автор - krosav4ig
Дата добавления - 21.03.2016 в 04:25
Controler Дата: Четверг, 24.03.2016, 19:04 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
Если я правильно понял, что из выше данных статей, для добавления подписи письмо нужно изменить добавить в мой макрос следующее:

[vba]
Код
Sub Перенос()
    With ThisWorkbook.Sheets("Отчет за сутки")
        .Range("A2:j" & .Cells(.Rows.Count, 1).End(xlUp).Row).SpecialCells(2).Copy Sheets("Отчет за 2016 г.").Range("A" & Rows.Count).End(xlUp)(2)
        .Copy
    With ActiveWorkbook
        .SendMail Recipients:=Array("пупкин@mail.ru", "васичкин@mail.ru")
        .Subject:="Статистика"
        .Body = "Во вложении отчет"
        .Attachments.Add  ("C:\test.txt")
        .Close SaveChanges:=False
    End With
    If ThisWorkbook.Saved = False Then
    ThisWorkbook.Save
    End If
    Application.Quit
    Sheets("Отчет за сутки").Range("A2:j" & .Cells(.Rows.Count, 1).End(xlUp).Row).ClearContents
    MsgBox ("Внесено в отчет за 2016 год, отправлено Пупкину и Васичкину!")
End Sub
[/vba]
 
Ответить
СообщениеЕсли я правильно понял, что из выше данных статей, для добавления подписи письмо нужно изменить добавить в мой макрос следующее:

[vba]
Код
Sub Перенос()
    With ThisWorkbook.Sheets("Отчет за сутки")
        .Range("A2:j" & .Cells(.Rows.Count, 1).End(xlUp).Row).SpecialCells(2).Copy Sheets("Отчет за 2016 г.").Range("A" & Rows.Count).End(xlUp)(2)
        .Copy
    With ActiveWorkbook
        .SendMail Recipients:=Array("пупкин@mail.ru", "васичкин@mail.ru")
        .Subject:="Статистика"
        .Body = "Во вложении отчет"
        .Attachments.Add  ("C:\test.txt")
        .Close SaveChanges:=False
    End With
    If ThisWorkbook.Saved = False Then
    ThisWorkbook.Save
    End If
    Application.Quit
    Sheets("Отчет за сутки").Range("A2:j" & .Cells(.Rows.Count, 1).End(xlUp).Row).ClearContents
    MsgBox ("Внесено в отчет за 2016 год, отправлено Пупкину и Васичкину!")
End Sub
[/vba]

Автор - Controler
Дата добавления - 24.03.2016 в 19:04
Controler Дата: Четверг, 24.03.2016, 19:05 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
А вот про отправку только последней заполненной строке ничего не понял. Статья на английском
 
Ответить
СообщениеА вот про отправку только последней заполненной строке ничего не понял. Статья на английском

Автор - Controler
Дата добавления - 24.03.2016 в 19:05
Controler Дата: Вторник, 29.03.2016, 20:00 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
Не получается добавить подпись и тест письма
 
Ответить
СообщениеНе получается добавить подпись и тест письма

Автор - Controler
Дата добавления - 29.03.2016 в 20:00
krosav4ig Дата: Среда, 30.03.2016, 22:28 | Сообщение № 6
Группа: Друзья
Ранг: Старожил
Сообщений: 2346
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Controler, попробуйте так [vba]
Код
Sub Перенос()
    Dim rng As Range, strFile$, OutApp As Object, bool As Boolean
    strFile$ = Environ("tmp") & "\последняя строка.xls"
    With ThisWorkbook.Sheets("Отчет за сутки")
        On Error Resume Next
        Set rng = .Range("A2:j" & Application.Max(.Cells(.Rows.Count, 1).End(xlUp).Row, 2)).SpecialCells(2)
        If rng Is Nothing Then
            MsgBox "Нет данных для переноса!"
            Exit Sub
        End If
        Application.DisplayAlerts = False
        rng.Copy Sheets("Отчет за 2016 г.").Range("A" & .Rows.Count).End(xlUp)(2)
        .Copy
        With ActiveWorkbook
            With .Sheets(1)
                .Rows(2).Resize(rng.Rows.Count - 1).Delete
                .Range(.Rows(3), .Rows(3).End(xlDown)).Delete
                .SaveAs strFile$, 56: .Parent.Close
            End With
        End With
        Set OutApp = GetObject(, "Outlook.Application")
        Err.Clear
        If OutApp Is Nothing Then
            Set OutApp = CreateObject("Outlook.Application")
            bool = True
        End If
        With OutApp.CreateItem(0)
            .To = Join(Array("пупкин@mail.ru", "васичкин@mail.ru"), ";")
            .Subject = "Статистика"
            .Body = "Во вложении отчет"
            .Attachments.Add strFile
            .Send
        End With
        Kill strFile
        If bool Then OutApp.Quit
        Set OutApp = Nothing
        rng.ClearContents: .Parent.Save
        MsgBox ("Внесено в отчет за 2016 год, отправлено Пупкину и Васичкину!")
    End With
    Application.DisplayAlerts = True
End Sub
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Среда, 30.03.2016, 22:29
 
Ответить
СообщениеControler, попробуйте так [vba]
Код
Sub Перенос()
    Dim rng As Range, strFile$, OutApp As Object, bool As Boolean
    strFile$ = Environ("tmp") & "\последняя строка.xls"
    With ThisWorkbook.Sheets("Отчет за сутки")
        On Error Resume Next
        Set rng = .Range("A2:j" & Application.Max(.Cells(.Rows.Count, 1).End(xlUp).Row, 2)).SpecialCells(2)
        If rng Is Nothing Then
            MsgBox "Нет данных для переноса!"
            Exit Sub
        End If
        Application.DisplayAlerts = False
        rng.Copy Sheets("Отчет за 2016 г.").Range("A" & .Rows.Count).End(xlUp)(2)
        .Copy
        With ActiveWorkbook
            With .Sheets(1)
                .Rows(2).Resize(rng.Rows.Count - 1).Delete
                .Range(.Rows(3), .Rows(3).End(xlDown)).Delete
                .SaveAs strFile$, 56: .Parent.Close
            End With
        End With
        Set OutApp = GetObject(, "Outlook.Application")
        Err.Clear
        If OutApp Is Nothing Then
            Set OutApp = CreateObject("Outlook.Application")
            bool = True
        End If
        With OutApp.CreateItem(0)
            .To = Join(Array("пупкин@mail.ru", "васичкин@mail.ru"), ";")
            .Subject = "Статистика"
            .Body = "Во вложении отчет"
            .Attachments.Add strFile
            .Send
        End With
        Kill strFile
        If bool Then OutApp.Quit
        Set OutApp = Nothing
        rng.ClearContents: .Parent.Save
        MsgBox ("Внесено в отчет за 2016 год, отправлено Пупкину и Васичкину!")
    End With
    Application.DisplayAlerts = True
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 30.03.2016 в 22:28
Controler Дата: Суббота, 02.04.2016, 01:58 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
Это макрос работает, но не совсем как надо:
1. Если Outlook не запущен, то письмо не отправляется
2. Если запущен, то отправляется пустое письмо, почему то без отчета.
 
Ответить
СообщениеЭто макрос работает, но не совсем как надо:
1. Если Outlook не запущен, то письмо не отправляется
2. Если запущен, то отправляется пустое письмо, почему то без отчета.

Автор - Controler
Дата добавления - 02.04.2016 в 01:58
Controler Дата: Суббота, 02.04.2016, 02:00 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
.Attachments.Add strFile


Почему то письмо создается без вложения
 
Ответить
Сообщение
.Attachments.Add strFile


Почему то письмо создается без вложения

Автор - Controler
Дата добавления - 02.04.2016 в 02:00
Controler Дата: Воскресенье, 24.04.2016, 06:52 | Сообщение № 9
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
[vba]
Код
56: .Parent.Close
[/vba]

Что означает эта строка? С ней не отправляется письмо, если убрать то отправляется
 
Ответить
Сообщение[vba]
Код
56: .Parent.Close
[/vba]

Что означает эта строка? С ней не отправляется письмо, если убрать то отправляется

Автор - Controler
Дата добавления - 24.04.2016 в 06:52
krosav4ig Дата: Среда, 27.04.2016, 17:17 | Сообщение № 10
Группа: Друзья
Ранг: Старожил
Сообщений: 2346
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
.Parent.Close
в данном контексте закрытие временной книги
попробуйте так
[vba]
Код
Sub Перенос()
    Dim rng As Range, strFile$, OutApp As Object, bool As Boolean
    strFile$ = Environ("tmp") & "\последняя строка.xls"     'путь временного файла
    With ThisWorkbook.Sheets("Отчет за сутки")
        Set rng = .Range("A2:j" & Application.Max( _
        .Cells(.Rows.Count, 1).End(xlUp).Row, 2))       'задаем диапазон для переноса на лист Отчет 2016
        If Application.CountA(rng) = 0 Then             'если данных для переноса нет (CountA - это функция СЧЁТЗ)
            MsgBox "Нет данных для переноса!"           'выводим сообщение
            Exit Sub                    'и завершаем работу
        End If
        Application.DisplayAlerts = False
        rng.Copy Sheets("Отчет за 2016 г.").Range _
            ("A" & .Rows.Count).End(xlUp)(2)            'копируем диапазон на лист "Отчет за 2016 г."
        .Copy                    'копируем лист "Отчет за сутки" в новую книгу
                    '(она автоматически становится активной)
        With ActiveWorkbook                             'в новой книге со скопированным листом "Отчет за сутки"
            With .Sheets(1)                             'на листе "Отчет за сутки"
                If rng.Rows.Count > 1 Then                   'если в диапазоне больше 1 строки, то
                .Rows(2).Resize(rng.Rows.Count - 1).Delete   'удаляем строки со 2 по предпоследнюю включительно
                End If
                .Range(.Rows(3), .Rows(3).End(xlDown)).Delete 'удаляем все строки ниже последней непустой строки
                .SaveAs strFile$, 56                    'сохраняем книгу во временную папку
            End With
            .Close                    'закрываем временную книгу
        End With
        On Error Resume Next
                    
        Set OutApp = GetObject(, "Outlook.Application") 'пытаемся подключиться к запущенному Outllok
        Err.Clear
        On Error GoTo 0
        If OutApp Is Nothing Then                       'если Outllok не был запущен
            Set OutApp = CreateObject("Outlook.Application") 'запускаем новый экземпляр Outllok
            bool = True                    'после отправки нужно будет его закрыть
        End If
        With OutApp.CreateItem(0)                       'новое письмо
            .To = Join(Array("пупкин@mail.ru", _
                             "васичкин@mail.ru" _
                             ), ";")                    'список получателей
            .Subject = "Статистика"                     'тема письма
            .Body = "Во вложении отчет"                 'текст письма
            .Attachments.Add strFile                    'прикремпляем файл
            .Send                    'отправляем
        End With
        DoEvents
        Kill strFile                    'удаляем временный файл
        If bool Then OutApp.Quit                        'закрываем Outlook, если он был запущен макросом
        Set OutApp = Nothing
        rng.ClearContents: .Parent.Save                 'очищаем диапазон и сохраняем книгу
        MsgBox ("Внесено в отчет за 2016 год, отправлено Пупкину и Васичкину!")
    End With
    Application.DisplayAlerts = True
End Sub
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщение
.Parent.Close
в данном контексте закрытие временной книги
попробуйте так
[vba]
Код
Sub Перенос()
    Dim rng As Range, strFile$, OutApp As Object, bool As Boolean
    strFile$ = Environ("tmp") & "\последняя строка.xls"     'путь временного файла
    With ThisWorkbook.Sheets("Отчет за сутки")
        Set rng = .Range("A2:j" & Application.Max( _
        .Cells(.Rows.Count, 1).End(xlUp).Row, 2))       'задаем диапазон для переноса на лист Отчет 2016
        If Application.CountA(rng) = 0 Then             'если данных для переноса нет (CountA - это функция СЧЁТЗ)
            MsgBox "Нет данных для переноса!"           'выводим сообщение
            Exit Sub                    'и завершаем работу
        End If
        Application.DisplayAlerts = False
        rng.Copy Sheets("Отчет за 2016 г.").Range _
            ("A" & .Rows.Count).End(xlUp)(2)            'копируем диапазон на лист "Отчет за 2016 г."
        .Copy                    'копируем лист "Отчет за сутки" в новую книгу
                    '(она автоматически становится активной)
        With ActiveWorkbook                             'в новой книге со скопированным листом "Отчет за сутки"
            With .Sheets(1)                             'на листе "Отчет за сутки"
                If rng.Rows.Count > 1 Then                   'если в диапазоне больше 1 строки, то
                .Rows(2).Resize(rng.Rows.Count - 1).Delete   'удаляем строки со 2 по предпоследнюю включительно
                End If
                .Range(.Rows(3), .Rows(3).End(xlDown)).Delete 'удаляем все строки ниже последней непустой строки
                .SaveAs strFile$, 56                    'сохраняем книгу во временную папку
            End With
            .Close                    'закрываем временную книгу
        End With
        On Error Resume Next
                    
        Set OutApp = GetObject(, "Outlook.Application") 'пытаемся подключиться к запущенному Outllok
        Err.Clear
        On Error GoTo 0
        If OutApp Is Nothing Then                       'если Outllok не был запущен
            Set OutApp = CreateObject("Outlook.Application") 'запускаем новый экземпляр Outllok
            bool = True                    'после отправки нужно будет его закрыть
        End If
        With OutApp.CreateItem(0)                       'новое письмо
            .To = Join(Array("пупкин@mail.ru", _
                             "васичкин@mail.ru" _
                             ), ";")                    'список получателей
            .Subject = "Статистика"                     'тема письма
            .Body = "Во вложении отчет"                 'текст письма
            .Attachments.Add strFile                    'прикремпляем файл
            .Send                    'отправляем
        End With
        DoEvents
        Kill strFile                    'удаляем временный файл
        If bool Then OutApp.Quit                        'закрываем Outlook, если он был запущен макросом
        Set OutApp = Nothing
        rng.ClearContents: .Parent.Save                 'очищаем диапазон и сохраняем книгу
        MsgBox ("Внесено в отчет за 2016 год, отправлено Пупкину и Васичкину!")
    End With
    Application.DisplayAlerts = True
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 27.04.2016 в 17:17
Ealataur Дата: Пятница, 01.09.2017, 14:49 | Сообщение № 11
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Вопрос в тему. А как сделать, чтобы при отправке без аутлук сообщение сохранялось в отправленных. Возможно такого нет, т.к. в msdn по CDO или MailMessage ничего нет
 
Ответить
СообщениеВопрос в тему. А как сделать, чтобы при отправке без аутлук сообщение сохранялось в отправленных. Возможно такого нет, т.к. в msdn по CDO или MailMessage ничего нет

Автор - Ealataur
Дата добавления - 01.09.2017 в 14:49
_Boroda_ Дата: Пятница, 01.09.2017, 14:59 | Сообщение № 12
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Создайте свою тему.


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеСоздайте свою тему.

Автор - _Boroda_
Дата добавления - 01.09.2017 в 14:59
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос по отправке файла на почту (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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