Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Отправка вложений формата pdf через Outlook, нужно отправить все pdf файлы из определённой папки одним письмом
 
Добрый день.
есть следующий код:
Код
Sub SendMail()
    Dim objOL As Outlook.Application
    Dim objMail As MailItem
    Set objOL = Outlook.Application
    Set objMail = objOL.CreateItem(olMailItem)
        With objMail
            .To = "mykhaylo_horzov@jabil.com"
            .Body = "Masseage"
            .Subject = "Test VBA"
            .Attachments.Add "C:\Users\horzovm\Desktop\STOSA\pdf\12345.pdf"
            .Send
        End With
    Set objMail = Nothing
    Set objOL = Nothing
End Sub

который отправляет один файл 12345.pdf через Outlook. Задача следующая - можно ли сделать так чтоб отправлялись ВСЕ файлы из папки C:\Users\horzovm\Desktop\STOSA\pdf\ ? файлы генерируються програмой SAP и всегда имеют разные имена ( тоесть имена не повторяються ) и прописывать каждый раз строчку с полным путём к файлу дольше чем вручную отправить. Возможно ли изменить строку

Код
.Attachments.Add "C:\Users\horzovm\Desktop\STOSA\pdf\12345.pdf"

так чтоб в вложение попали ВСЕ файлы из папки? к сожалению такого решения в сети не нашел...
Буду Очень благодарен за любой совет.
Изменено: sabotazh - 4 Июн 2018 09:51:24
 
вот
https://www.planetaexcel.ru/techniques/3/45/
перебираете циклом все файлы в папке и в этом же цикле добавляете в письмо
 
К сожалению моих знаний VBA не хватит для этого.
Но большое спасибо что откликнулись, буду пробовать...
 

слепил по-быстрому..

Код
Sub send_mail()
Dim objOutApp As Object, objMail As Object, sh As Worksheet
Dim BrowseFolder As String, V As String
Set objOutApp = CreateObject("Outlook.Application")
Set objMail = objOutApp.CreateItem(0)
'открываем диалоговое окно выбора папки
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Выберите папку или диск"
    .Show
    On Error Resume Next
    Err.Clear
    V = .SelectedItems(1)
    If Err.Number <> 0 Then
        MsgBox "Вы ничего не выбрали!"
        Exit Sub
    End If
End With
    BrowseFolder = CStr(V)
    Dim FSO As Object
    Dim SourceFolder As Object
    Dim FileItem As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.getfolder(BrowseFolder)
        With objMail
            .To = "mykhaylo_horzov@jabil.com"
            .Body = "Masseage"
            .Subject = "Test VBA"
        For Each FileItem In SourceFolder.Files
            .Attachments.Add FileItem.Path
        Next
            .display
        End With
End Sub

Изменено: yozhik - 4 Июн 2018 10:44:39
 
Цитата
yozhik написал:
слепил по-быстрому..
Огромнейшее спасибо.
Всё работает!
 
если папка у Вас одна и та же, то блок с выбором папки (с 7 по 17 строчку) можно удалить и написать в 18-й строке просто
Код
BrowseFolder="C:\Users\horzovm\Desktop\STOSA\pdf"
 
Код
Попробуйте, рассылка идет из xls

Создаем сообщение из шаблона
       On Error GoTo Template_Is_Missing
       Set OutMail = OutApp.CreateItemFromTemplate(Cells(i, 3))
       On Error GoTo 0
       
       On Error Resume Next
       
       OutMail.To = Cells(i, 1)
       OutMail.Subject = Cells(i, 2)
   
       'Поиск вложений к письму
       If Cells(i, 4) <> "" Then

           If FSO.FolderExists(Cells(i, 4)) = True Then    'Папка
               'Проверяем файлы в папке
               Set SourceFolder = FSO.getfolder(Cells(i, 4))

               FilesExist = False
               For Each FileItem In SourceFolder.Files
                   FilesExist = True
                   OutMail.Attachments.Add FileItem.Path
               Next FileItem

               Set FileItem = Nothing
               Set SourceFolder = Nothing

               'Проверяем было ли хоть одно вложение
               If FilesExist = False Then
                   Cells(i, 5) = "Отсутствуют файлы в папке"
               Else
                   Cells(i, 5) = ""
               End If
           Else
               If FSO.FileExists(Cells(i, 4)) = True Then  'Файл
                   MyPath = Cells(i, 4)
                   OutMail.Attachments.Add MyPath
                   Cells(i, 5) = ""

Изменено: Alina Exsel - 4 Июн 2018 12:20:55 (dd)
 
Alina Exsel, Вы видели, как у других формлен код? Вот и Вы оформляйте аналогично: ищите такую кнопку и исправьте своё сообщение.
Тег VBA.jpg (19.2 КБ)
Страницы: 1
Читают тему (гостей: 1)
Наверх