Страницы: 1
RSS
Отправить все pdf файлы из определённой папки одним письмом через Outlook
 
Добрый день.
есть следующий код:
Код
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 - 12.03.2019 11:06:01
 
вот
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 - 04.06.2018 10:44:39
 
Огромнейшее спасибо.
Всё работает!
 
если папка у Вас одна и та же, то блок с выбором папки (с 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[/P]
                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 - 12.03.2019 11:05:20 (dd)
 
Alina Exsel, Вы видели, как у других формлен код? Вот и Вы оформляйте аналогично: ищите такую кнопку и исправьте своё сообщение.
 
Доброго времени суток.
Уважаемые профи - подскажите как добавить в код (перед отправкой письма) возможность выбора файлов в папке?
Код
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
с недавних пор в папку скидывают все файлы и перед поэтому (перед отправкой письма) нужно выбрать какие именно файлы отправлять в письме.
пока что сам не разобрался, но думаю нужно смотреть в сторону msoFileDialogFilePicker - окно выбора файлов вышло, а вот приатачить их к письму не получилось...

помогите.
Изменено: sabotazh - 05.03.2019 10:41:20
 
попробую разок поднять тему
Страницы: 1
Наверх