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

Вход

Регистрация

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

 

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

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир 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(84Kb)
 
Ответить
СообщениеНазначил на кнопку макрос по отправке файла на почту, письмо с вложением файла формируется и отправляется, но ни как не могу чтобы в письме был мой текст, выдается ошибка.
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
Группа: Друзья
Ранг: Старожил
Сообщений: 1357
Репутация: 548 ±
Замечаний: 0% ±

Excel 2007, 2013


(_)Õvõ(_)
 
Ответить
Сообщениессылка номер раз
ссылка номер два

Автор - 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
Группа: Друзья
Ранг: Старожил
Сообщений: 1357
Репутация: 548 ±
Замечаний: 0% ±

Excel 2007, 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]


(_)Õvõ(_)

Сообщение отредактировал 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
Группа: Друзья
Ранг: Старожил
Сообщений: 1357
Репутация: 548 ±
Замечаний: 0% ±

Excel 2007, 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]


(_)Õvõ(_)
 
Ответить
Сообщение
.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
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос по отправке файла на почту (Макросы/Sub)
Страница 1 из 11
Поиск:

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