Версия для слабовидящих
Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

 

= Мир MS Excel/Группировка файлов в мэйл - Мир MS Excel

  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_, DrMini  
Группировка файлов в мэйл
Oh_Nick Дата: Четверг, 21.04.2022, 15:12 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 445
Репутация: 8 ±
Замечаний: 20% ±

Excel 2019
Всем, добрый день!

Имеется код, который путем нажатия кнопки формирует письмо с вложенным листом в него. Формирует он письмо исходя из принципа 1 мэйл - 1 письмо - 1 файл в письм. А как сделать, чтобы если мэйлы повторялись, то он вкладывал туда несколько листов, а не делал несколько писем?

If x_Select = True Then

            Cost_Center = Cells(9 + j, 2).Value
            x_Sheet = Cells(9 + j, 3).Value
            sentTo = Cells(9 + j, 4).Value
            sentCC = Cells(9 + j, 5).Value
            SubjectTitle = Cells(9 + j, 6).Value
            x_Title = Cells(9 + j, 7).Value
            
            
            
'====================================================================================================================
' End of Section 1 sets up the parameters for the preparation of the mail and the extraction of the requested tab
'====================================================================================================================
            
'====================================================================================================================
' Section 2: Save the requested tab in a new file and prepare the mail
'====================================================================================================================
                        

relativePath = ThisWorkbook.Path & "\" & Format(Date, "yyyymmdd") & "_" & x_Sheet & "_Cost center overview"

Sheets(x_Sheet).Copy
ChDir ThisWorkbook.Path
ActiveWorkbook.SaveAs Filename:=relativePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close False

Sheets("E-mail").Activate
                            
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
                    
'This is where we set-up the mail text including parameters from generator file (deadlines)
                    
strbody = x_Title & "<br><br>" & Cells(37, 2) & "<br>" & Cells(38, 2) & "<br>" & Cells(39, 2) & "<br><br>" & Cells(40, 2) & "<br>" & Cells(41, 2) & "<br>" & Cells(42, 2) & "<br><br>" & Cells(43, 2) & "<br><br>" & Cells(44, 2) & "<br>" & Cells(45, 2)
                    
With OutMail
.To = sentTo
.CC = sentCC
.Subject = SubjectTitle
.HTMLBody = "<p style='font-family:arial;font-size:13'>" & strbody & "<br>" & "</p>" & .HTMLBody
.Attachments.Add relativePath & ".xlsx"
.Display
End With
                        
Set OutMail = Nothing
Set OutApp = Nothing
                        
'====================================================================================================================
' End of Section 2: Save the filtered cleaned file and prepare the mail
'====================================================================================================================

Kill relativePath & ".xlsx"

End If
        
Next j

Application.ScreenUpdating = True

End Sub



Сообщение отредактировал Oh_Nick - Четверг, 21.04.2022, 15:23
 
Ответить
СообщениеВсем, добрый день!

Имеется код, который путем нажатия кнопки формирует письмо с вложенным листом в него. Формирует он письмо исходя из принципа 1 мэйл - 1 письмо - 1 файл в письм. А как сделать, чтобы если мэйлы повторялись, то он вкладывал туда несколько листов, а не делал несколько писем?

[vba]
If x_Select = Тrue Then            Cost_Center = Cells(9 + j; 2).Value            x_Sheet = Cells(9 + j; 3).Value            sentTo = Cells(9 + j; 4).Value            sentCC = Cells(9 + j; 5).Value            SubjectTitle = Cells(9 + j; 6).Value            x_Title = Cells(9 + j; 7).Value                                    '====================================================================================================================' End of Section 1 sets up the parameters for the preparation of the mail and the extraction of the requested tab'====================================================================================================================            '====================================================================================================================' Section 2: Save the requested tab in a new file and prepare the mail'====================================================================================================================                        relativePath = ThisWorkbook.Path & "\" & Format(Date; "yyyymmdd") & "_" & x_Sheet & "_Cost center overview"Sheets(x_Sheet).CopyChDir ThisWorkbook.PathActiveWorkbook.SaveAs Filename:=relativePath; FileFormat:=xlOpenXMLWorkbook; CreateBackup:=FalseActiveWorkbook.Close FalseSheets("E-mail").Activate                            Set OutApp = CreateObject("Outlook.Application")Set OutMail = OutApp.CreateItem(0)                    'This is where we set-up the mail text including parameters from generator file (deadlines)                    strbody = x_Title & "

" & Cells(37, 2) & "
" & Cells(38, 2) & "
" & Cells(39, 2) & "

" & Cells(40, 2) & "
" & Cells(41, 2) & "
" & Cells(42, 2) & "

" & Cells(43, 2) & "

" & Cells(44, 2) & "
" & Cells(45, 2)                    With OutMail.To = sentTo.CC = sentCC.Subject = SubjectTitle.HTMLBody = "

" & strbody & "
" & "

" & .HTMLBody.Attachments.Add relativePath & ".xlsx".DisplayEnd With                        Set OutMail = NothingSet OutApp = Nothing                        '====================================================================================================================' End of Section 2: Save the filtered cleaned file and prepare the mail'====================================================================================================================Kill relativePath & ".xlsx"End If        Next jApplication.ScreenUpdating = ТrueEnd Sub
[/vba]

Автор - Oh_Nick
Дата добавления - 21.04.2022 в 15:12
Oh_Nick Дата: Среда, 04.05.2022, 17:12 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 445
Репутация: 8 ±
Замечаний: 20% ±

Excel 2019
Можно закрыть тему.
 
Ответить
СообщениеМожно закрыть тему.

Автор - Oh_Nick
Дата добавления - 04.05.2022 в 17:12
Апострофф Дата: Среда, 04.05.2022, 18:11 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 467
Репутация: 129 ±
Замечаний: 0% ±

Excel 1997
Oh_Nick, а решением проблемы не поделитесь?
 
Ответить
СообщениеOh_Nick, а решением проблемы не поделитесь?

Автор - Апострофф
Дата добавления - 04.05.2022 в 18:11
  • Страница 1 из 1
  • 1
Поиск:

Рейтинг@Mail.ru Яндекс.Метрика Яндекс цитирования
© 2010-2025 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!