Интересный макрос для создания писем в Outlook через Excel

[Exo]

А если усложнить.

Например, подставить e-mail по условию.

Допустим в документе есть скрытый лист с двумя столбцами

Первый столбец это имя пользователя, второй это столбец с соответствующим мылом начальника.

Макрос узнает какой пользователь сейчас юзает макрос (Application.UserName), далее ищет на скрытом листе соответствующего данному пользователю начальника, подставляет мыло и отправляет.

Важно, не очень хочется заставлять пользователя сохранять отчет, куда интереснее было бы если бы макрос сам сохранял в темпа отчет (пусть да же если нужно создавая папку Temp на диске C), НО после отправки удалял. Отчет не имеет смысла хранить на жестком диске, ибо его всегда можно найти в отправленных.

Для чего может быть нужно:
человек заполняет отчет (ну скажем по затратам на командировку), после заполнения жмакает кнопку «post report» и отчет уходит его начальнику + было бы неплохо если бы в копии стояли несколько статический e-mail (например финансового директора и главного бухгалтера)


З.Ы. SAM888 Ваш макрос прекрасно работает на Outlook 2003

[Erroreus]

Есть макрос, который отсылает листы книги без формул, название листа - адрес получателя, помогите избавится от подтверждения на отсылку каждого листа, их много, неохота сидеть и подтверждать отсылку каждого листа. Shortcut: Ctrl+s


Sub Macro1()
'
'
' Keyboard Shortcut: Ctrl+s
'
On Error GoTo Err
Const FN = "C:\test.xls"
Dim i As Integer
If Application.MailSystem = xlMAPI Then
For i = 1 To Worksheets.Count
If Dir(FN, vbNormal) <> "" Then Kill (FN)
Worksheets(i).Copy
With Workbooks(Workbooks.Count)
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
' Rows("26:94").Select
' Selection.Delete Shift:=xlUp
.SaveAs Filename:=FN
.SendMail Recipients:=.Worksheets(1).Name, _
Subject:="Sales stat for " + .Worksheets(1).Name
.Close Not (.Saved), FN
End With
Next i
If Dir(FN, vbNormal) <> "" Then Kill (FN)
MsgBox "OK"
Else
MsgBox "No mail system installed"
End If
Exit Sub
Err:
MsgBox "ERROR"


End Sub

[Exo]

Сообщение от Exo

А если усложнить.

Например, подставить e-mail по условию.

Допустим в документе есть скрытый лист с двумя столбцами

Первый столбец это имя пользователя, второй это столбец с соответствующим мылом начальника.

Макрос узнает какой пользователь сейчас юзает макрос (Application.UserName), далее ищет на скрытом листе соответствующего данному пользователю начальника, подставляет мыло и отправляет.

Важно, не очень хочется заставлять пользователя сохранять отчет, куда интереснее было бы если бы макрос сам сохранял в темпа отчет (пусть да же если нужно создавая папку Temp на диске C), НО после отправки удалял. Отчет не имеет смысла хранить на жестком диске, ибо его всегда можно найти в отправленных.

Для чего может быть нужно:
человек заполняет отчет (ну скажем по затратам на командировку), после заполнения жмакает кнопку «post report» и отчет уходит его начальнику + было бы неплохо если бы в копии стояли несколько статический e-mail (например финансового директора и главного бухгалтера)


З.Ы. SAM888 Ваш макрос прекрасно работает на Outlook 2003

Вот я что смог родить, мой нубский вариант:

Sub Mail()
Dim x As Range, y As Range, Fst As String, Boss As String, OutlookApp As Object, SM As Object
   
    User = Application.UserName
    Set x = Columns("B").Find(User)
    Fst = x.Address
    Boss = Range(Fst).Offset(0, 6).Value
    
    Set OutlookApp = CreateObject("Outlook.Application")
    Set SM = OutlookApp.CreateItem(olMailItem)  'Создаем объект

    SM.To = Boss                                'Вставьте требуемый электронный адрес
    SM.Subject = "Report"                       'Заполнение поля "Тема"
    SM.Body = "TextReport"                      'Заполнение поля "Сообщение"
    SM.Attachments.Add "C:\Temp\abcd.xls"       'Путь к прикрепляемому файлу

    On Error Resume Next                        'Перехват возможной ошибки
    SM.Send                                     'Посылаем сообщени

    Set SM = Nothing                            'Очищаем использовавшиеся объекты
    Set OutlookApp = Nothing

End Sub

НО нет автосохранения и нет адресов для Копии письма...

[REcKon]

Сообщение от SAS888

...

Sub Mail()

    Dim OutlookApp As Object, SM As Object
    
    Set OutlookApp = CreateObject("Outlook.Application")
    Set SM = OutlookApp.CreateItem(olMailItem)  'Создаем объект
    
    SM.To = "User@mail.ru"                      'Вставьте требуемый электронный адрес
    SM.Subject = "Report"                       'Заполнение поля "Тема"
    
SM.Body = "TextReport"                      'Заполнение поля "Сообщение"
    SM.Attachments.Add "C:\Temp\abcd.xls"       'Путь к прикрепляемому файлу
    
    On Error Resume Next                        'Перехват возможной ошибки
    SM.Send                                     'Посылаем сообщение
    
    OutlookApp.Quit                             'Закрываем OutLook (если нужно)
    
    Set SM = Nothing                            'Очищаем использовавшиеся объекты
    Set OutlookApp = Nothing

End Sub

...

Подскажите пожалуйста, как текст поля "Сообщения" сделать в несколько строчек.
У меня все в одну строчу получается, а как перенести на другую, не знаю...

[EducatedFool]

как текст поля "Сообщения" сделать в несколько строчек

Попробуйте такие варианты:

    SM.Body = "Первая строка" & vbCrLf & "вторая строка" & vbCrLf & "третья строка"

    SM.Body = "Первая строка" & vbCr & "вторая строка" & vbCr & "третья строка"

    SM.Body = "Первая строка" & vbLf & "вторая строка" & vbLf & "третья строка"

Один из них должен Вам подойти.

[REcKon]

Спасибо!
То, что нужно!

[sakulich]

Подскажите пожалуйста, а можно ли сделать макрос который бы подставлял определенный адрес в копию всех писем при создании. но чтобы можно этот адрес было удалить, если все таки эта копия не нужна

[VictorM]

P.S. Не забудьте в Tools->Reference подключить библиотеки "Microsoft Office xx Object Library" и "Microsoft Outlook xx Object Library".

только вот что-то я не вижу у себя библиотеки "Microsoft Outlook xx Object Library" и естественно ничего не могу сделать.
подскажите пожалуйста, в чем дело (Excel 2003)