Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  

Показать сообщение отдельно

Динохромный


Contributor


Сообщения: 704
Благодарности: 320

Профиль | Отправить PM | Цитировать


darkman_, по поводу ужатия фотографий без изменения разрешения и т.п. посмотрите на www.jpegmini.com, правда программа платная. Лично я обычно не вижу разницы между оригиналом и ужатой фотографией по качеству, и тем более по свойствам (за исключением размера), пользуюсь наверное полгода. Но тут дело индивидуальное.
А по сути тут приведена программа на VBA, правда для отправки одного файла. Работает для Excel. По мне проще руками отправлять
Outlook настраивать у меня желания нет, подправил на коленке код, предполагается, что в столбце "А" вы должны указать полное имя каждого файла (по одному файлу на ячейку) - полные имена легко копируются например в Total commander, в ячейке "В1" вы должны указать почту, на которую будут отсылаться письма.
не факт что это корректно работает, не проверял:
Как-то так

Код: Выделить весь код
Option Explicit
 
Sub Send_Mail()
    Dim objOutlookApp As Object, objMail As Object
    Dim sTo As String, sSubject As String, sBody As String, sAttachment As String, i As Integer
 
    Application.ScreenUpdating = False
    On Error Resume Next
    Set objOutlookApp = CreateObject("Outlook.Application")
    objOutlookApp.Session.Logon
    i = 1
    Do While ActiveSheet.Cells(i, 1).Value <> ""
        Set objMail = objOutlookApp.CreateItem(0)   
        
        If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
        
        sTo = Range("B1").Value    'Адрес почты
        sSubject = "Фотографии"    
        sBody = "Добрый день, высылаю Вам фотографии"    
        sAttachment = ActiveSheet.Cells(i, 1).Value   
        
       
        With objMail
            .To = sTo 
            .Subject = sSubject 
            .Body = sBody 
            .Attachments.Add sAttachment
            .Send 
        End With
        Set objMail = Nothing
        i = i + 1
    Loop
exit_:
    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
End Sub

PS есть такое подозрение, что в VBA-редакторе в меню Tools-> References нужно найти Outlook и выставить напротив нее галочку.

Последний раз редактировалось a_axe, 23-09-2014 в 18:06.


Отправлено: 17:57, 23-09-2014 | #4