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 и всегда имеют разные имена ( тоесть имена не повторяються ) и прописывать каждый раз строчку с полным путём к файлу дольше чем вручную отправить. Возможно ли изменить строку
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
Создаем сообщение из шаблона
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) = ""
Доброго времени суток. Уважаемые профи - подскажите как добавить в код (перед отправкой письма) возможность выбора файлов в папке?
Код
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 - окно выбора файлов вышло, а вот приатачить их к письму не получилось...