Ну все же надо не прям полные куски вставлять, даже не вчитываясь в процесс
Код |
---|
Sub Get_All_File_from_Folder()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim sFolder As String, sFiles As String
'диалог запроса выбора папки с файлами
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = False Then Exit Sub
sFolder = .SelectedItems(1)
End With
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application") 'запускаем Outlook в скрытом режиме
OutApp.Session.Logon
On Error GoTo cleanup 'если не запустился - выходим
Set OutMail = OutApp.CreateItem(0) 'создаем новое сообщение
On Error Resume Next
sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
'заполняем поля сообщения
With OutMail
.To = Range("A1").Value
.Subject = Range("A2").Value
.Body = Range("A3").Value
sFiles = Dir(sFolder & "*.xls*")
Do While sFiles <> ""
'добавляем файл из папки как вложение
.Attachments.Add sFolder & sFiles
sFiles = Dir
Loop
'команду Send можно заменить на Display, чтобы посмотреть сообщение перед отправкой
.Display '.Send
End With
On Error GoTo 0
Set OutMail = Nothing
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub |
раз статью явно не читали, то обращаю внимание на строку:
Код |
---|
sFiles = Dir(sFolder & "*.xls*") |
она отбирает только файлы Excel. Если нужны все, то строка должна выглядеть так:
Код |
---|
sFiles = Dir(sFolder & "*.*") |