Назначил на кнопку макрос по отправке файла на почту, письмо с вложением файла формируется и отправляется, но ни как не могу чтобы в письме был мой текст, выдается ошибка. 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]
Назначил на кнопку макрос по отправке файла на почту, письмо с вложением файла формируется и отправляется, но ни как не могу чтобы в письме был мой текст, выдается ошибка. 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]
Код
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
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]
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
Это макрос работает, но не совсем как надо: 1. Если Outlook не запущен, то письмо не отправляется 2. Если запущен, то отправляется пустое письмо, почему то без отчета.
Это макрос работает, но не совсем как надо: 1. Если Outlook не запущен, то письмо не отправляется 2. Если запущен, то отправляется пустое письмо, почему то без отчета.Controler
в данном контексте закрытие временной книги попробуйте так [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]
Код
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
Вопрос в тему. А как сделать, чтобы при отправке без аутлук сообщение сохранялось в отправленных. Возможно такого нет, т.к. в msdn по CDO или MailMessage ничего нет
Вопрос в тему. А как сделать, чтобы при отправке без аутлук сообщение сохранялось в отправленных. Возможно такого нет, т.к. в msdn по CDO или MailMessage ничего нетEalataur