Здравствуйте, все! В конце макроса вызываю окно почты (у меня Outlook) [vba]
Код
Application.Dialogs(xlDialogSendMail).Show
[/vba] Если отправить письмо сразу, то Excel вылетает. Если подождать несколько секунд (3-7) - все норм. Outlook в других ошибках не замечен, MS офис лицензионный обновленный. Этот феномен существует в нескольких файлах с разными макросами. Объединяет их только вызов окна почты. Предполагаю, что проблема лечится задержкой выполнения, вроде Application.Wait (правда, еще не пробовал). Однако, если делать задержку стандартную, то придется ждать это время и тогда, когда не нужно. А если сделать задержку маленькой, то вылетать все равно будет, хоть и не так часто. Может кто-нибудь подсказать решение проблемы?
Образец файла не прикладываю: большой, по коммерческим соображениям; а в обрезанном этой проблемы нет, как ни старался.
Здравствуйте, все! В конце макроса вызываю окно почты (у меня Outlook) [vba]
Код
Application.Dialogs(xlDialogSendMail).Show
[/vba] Если отправить письмо сразу, то Excel вылетает. Если подождать несколько секунд (3-7) - все норм. Outlook в других ошибках не замечен, MS офис лицензионный обновленный. Этот феномен существует в нескольких файлах с разными макросами. Объединяет их только вызов окна почты. Предполагаю, что проблема лечится задержкой выполнения, вроде Application.Wait (правда, еще не пробовал). Однако, если делать задержку стандартную, то придется ждать это время и тогда, когда не нужно. А если сделать задержку маленькой, то вылетать все равно будет, хоть и не так часто. Может кто-нибудь подсказать решение проблемы?
Образец файла не прикладываю: большой, по коммерческим соображениям; а в обрезанном этой проблемы нет, как ни старался.pabchek
"Учиться, учиться и еще раз учиться!" WM: R399923528092
Sub мяу() Set FSO = CreateObject("Scripting.FileSystemObject") Set File = FSO.GetFile("E:\Documents and Settings\Андр\Мои документы\4644779.xls") If File.Size > 100000 Then MsgBox "Мяууууу!" Set File = FSO.GetFile("E:\Documents and Settings\Андр\Мои документы\4644779.xlsb") If File.Size <= 100000 Then MsgBox "Мяу!" End Sub
[/vba]
[vba]
Код
Sub мяу() Set FSO = CreateObject("Scripting.FileSystemObject") Set File = FSO.GetFile("E:\Documents and Settings\Андр\Мои документы\4644779.xls") If File.Size > 100000 Then MsgBox "Мяууууу!" Set File = FSO.GetFile("E:\Documents and Settings\Андр\Мои документы\4644779.xlsb") If File.Size <= 100000 Then MsgBox "Мяу!" End Sub
В проблемных файлах я отображаю диалоговое окно, ибо нужно выбирать получателя. Или у Вас академический интерес какой код я использую? [offtop] RAN, смотрю код, но пока еще не сообразил как это мне поможет[/offtop]
В проблемных файлах я отображаю диалоговое окно, ибо нужно выбирать получателя. Или у Вас академический интерес какой код я использую? [offtop] RAN, смотрю код, но пока еще не сообразил как это мне поможет[/offtop]pabchek
"Учиться, учиться и еще раз учиться!" WM: R399923528092
Сообщение отредактировал pabchek - Четверг, 26.05.2016, 11:21
Не совсем понятен вопрос. В больших файлах Excel вылетает, а в маленьких нет? Тогда, как вариант, опытным путем выяснить, на какой размер файла какую задержку нужно ставить и в макросе прописывать что-то типа [vba]
Код
ThisWorkbook.Save 'сохраняемся fp_ = ThisWorkbook.Path & "\" & ThisWorkbook.Name 'полный путь к файлу fr_ = FileLen(fp_) 'размер файла n_ = fr_ / 500 'делим размер на полученный экспериментально коэффициент t_ = TimeValue("0:00:01") * n_ 'задержка в секундах If Application.Wait(Now + t_) Then Application.Dialogs(xlDialogSendMail).Show End If
Не совсем понятен вопрос. В больших файлах Excel вылетает, а в маленьких нет? Тогда, как вариант, опытным путем выяснить, на какой размер файла какую задержку нужно ставить и в макросе прописывать что-то типа [vba]
Код
ThisWorkbook.Save 'сохраняемся fp_ = ThisWorkbook.Path & "\" & ThisWorkbook.Name 'полный путь к файлу fr_ = FileLen(fp_) 'размер файла n_ = fr_ / 500 'делим размер на полученный экспериментально коэффициент t_ = TimeValue("0:00:01") * n_ 'задержка в секундах If Application.Wait(Now + t_) Then Application.Dialogs(xlDialogSendMail).Show End If
RAN, _Boroda_, да, ваши коды работают (после рашпиля:)). Я то думал, что есть программная возможность отследить, закончил ли работу макрос. Я так понимаю, что основная моя проблема в том, что несмотря на то, что макрос передал на выполнение следующую строчку, какие-то процессы еще "доделываются" и вызывают сбой при вызове "недружелюбного" Аутлука.
RAN, _Boroda_, да, ваши коды работают (после рашпиля:)). Я то думал, что есть программная возможность отследить, закончил ли работу макрос. Я так понимаю, что основная моя проблема в том, что несмотря на то, что макрос передал на выполнение следующую строчку, какие-то процессы еще "доделываются" и вызывают сбой при вызове "недружелюбного" Аутлука.pabchek
"Учиться, учиться и еще раз учиться!" WM: R399923528092
Возможно стоит использовать синхронизацию? не знаю есть ли что-то специфичное в vba, но в других языках я бы делал так. Один процесс лочится пока другой не закончил работу
p.s. глянув в гугле нашёл пример с глобальными переменными - выглядит кастыльно.
Возможно стоит использовать синхронизацию? не знаю есть ли что-то специфичное в vba, но в других языках я бы делал так. Один процесс лочится пока другой не закончил работу
p.s. глянув в гугле нашёл пример с глобальными переменными - выглядит кастыльно.Матраскин
Проверил в боевых условиях. Ставил разные сроки задержки. Довел до абсурдно большой. Проблема осталась. Значит вопрос не во времени. Сбой происходит в момент нажатия кнопки "отправить" в Аутлуке. Значит, похоже, Аутлук с Экселем не дружат. :( [vba]
Код
Sub Выбор() ... Application.Wait (Now + TimeValue("0:00:40")) Application.Dialogs(xlDialogSendMail).Show End Sub
[/vba]
Проверил в боевых условиях. Ставил разные сроки задержки. Довел до абсурдно большой. Проблема осталась. Значит вопрос не во времени. Сбой происходит в момент нажатия кнопки "отправить" в Аутлуке. Значит, похоже, Аутлук с Экселем не дружат. :( [vba]
Код
Sub Выбор() ... Application.Wait (Now + TimeValue("0:00:40")) Application.Dialogs(xlDialogSendMail).Show End Sub
Dim OutlookApp As Object, SM As Object Set OutlookApp = CreateObject("Outlook.Application") Set SM = OutlookApp.CreateItem(olMailItem) SM.To = "mail@example.ru" SM.CC = "mail@example.ru" SM.Subject = "Текст письма" On Error Resume Next SM.Body = "Текст письма" SM.Attachments.Add ("C:\Test.xls") SM.Display Set SM = Nothing Set OutlookApp = Nothing
[/vba]
pabchek,
[vba]
Код
Dim OutlookApp As Object, SM As Object Set OutlookApp = CreateObject("Outlook.Application") Set SM = OutlookApp.CreateItem(olMailItem) SM.To = "mail@example.ru" SM.CC = "mail@example.ru" SM.Subject = "Текст письма" On Error Resume Next SM.Body = "Текст письма" SM.Attachments.Add ("C:\Test.xls") SM.Display Set SM = Nothing Set OutlookApp = Nothing
Sub Выбор() Application.ScreenUpdating = 0 S = Range("A" & Rows.Count).End(xlUp).Row имя_файла = Range("X2") 'здесь заранее выбираю адресат выпадающим списком ActiveWorkbook.Save 'сохраняю чтобы запомнился последний адресат Range("$A:$O").AutoFilter Field:=6, Criteria1:="<>*" & Range("X2") & "*" 'сам не люблю "открытые" диапазоны, но в данном случае это не вслияет Range("A2:A" & S).SpecialCells(xlCellTypeVisible).EntireRow.Delete xlUp ActiveSheet.ShowAllData ActiveWorkbook.RefreshAll 'в файле два листа со сводными. Здесь обновляются Sheets("Форма").Select Application.DisplayAlerts = False Sheets(Array("SI", "Списки")).Delete ActiveWorkbook.SaveAs "D:\Путь\" & _ Left(Date, 2) & "-" & Mid(Date, 4, 2) & "_Статистика(" & имя_файла & ").xlsx", FileFormat:=51 Application.DisplayAlerts = True 'Application.Wait (Now + TimeValue("0:00:40")) Application.Dialogs(xlDialogSendMail).Show End Sub
[/vba]
В файле данные - 500 тыс.строк Макросом убираю ненужные значения, сохраняю файл с именем адресата и в формате "xlsx" (без макросов). Открывается окно почты. Вставляю адрес. Жму "Отправить". Всё. Краш программы. Можно адрес вставлять макросом же. Но адреса периодически меняются и хотел контролировать этот момент.
[p.s.]Добавляю. Письмо при этом уходит. Файл формируется и сохраняется нормально
Матраскин, код еще не подогнал для себя. Но видел и делаю)))
Sub Выбор() Application.ScreenUpdating = 0 S = Range("A" & Rows.Count).End(xlUp).Row имя_файла = Range("X2") 'здесь заранее выбираю адресат выпадающим списком ActiveWorkbook.Save 'сохраняю чтобы запомнился последний адресат Range("$A:$O").AutoFilter Field:=6, Criteria1:="<>*" & Range("X2") & "*" 'сам не люблю "открытые" диапазоны, но в данном случае это не вслияет Range("A2:A" & S).SpecialCells(xlCellTypeVisible).EntireRow.Delete xlUp ActiveSheet.ShowAllData ActiveWorkbook.RefreshAll 'в файле два листа со сводными. Здесь обновляются Sheets("Форма").Select Application.DisplayAlerts = False Sheets(Array("SI", "Списки")).Delete ActiveWorkbook.SaveAs "D:\Путь\" & _ Left(Date, 2) & "-" & Mid(Date, 4, 2) & "_Статистика(" & имя_файла & ").xlsx", FileFormat:=51 Application.DisplayAlerts = True 'Application.Wait (Now + TimeValue("0:00:40")) Application.Dialogs(xlDialogSendMail).Show End Sub
[/vba]
В файле данные - 500 тыс.строк Макросом убираю ненужные значения, сохраняю файл с именем адресата и в формате "xlsx" (без макросов). Открывается окно почты. Вставляю адрес. Жму "Отправить". Всё. Краш программы. Можно адрес вставлять макросом же. Но адреса периодически меняются и хотел контролировать этот момент.
[p.s.]Добавляю. Письмо при этом уходит. Файл формируется и сохраняется нормально
Матраскин, код еще не подогнал для себя. Но видел и делаю)))pabchek
"Учиться, учиться и еще раз учиться!" WM: R399923528092
Сообщение отредактировал pabchek - Пятница, 27.05.2016, 13:56
Попробуйте код отсюда: Проверял - работает и с одним и с другим оутлуками. [vba]
Код
Sub test() b = OutlookExpressSend(ActiveWorkbook, "xxxxx@s.net", "Hello this is test") End Sub
[/vba]
[vba]
Код
Function OutlookExpressSend(WB As Workbook, ByVal stRecipient As String, ByVal stSubject As String) 'For Tips see: http://www.rondebruin.nl/win/winmail/div/tips.htm 'Working in Excel 2000-2016 Dim i As Long On Error Resume Next For i = 1 To 3 WB.SendMail stRecipient, stSubject, True If Err.Number = 0 Then Exit For Next i OutlookExpressSend = Err.Number = 0 End Function
[/vba]
А у Вас какой outlook? microsoft или express?
Попробуйте код отсюда: Проверял - работает и с одним и с другим оутлуками. [vba]
Код
Sub test() b = OutlookExpressSend(ActiveWorkbook, "xxxxx@s.net", "Hello this is test") End Sub
[/vba]
[vba]
Код
Function OutlookExpressSend(WB As Workbook, ByVal stRecipient As String, ByVal stSubject As String) 'For Tips see: http://www.rondebruin.nl/win/winmail/div/tips.htm 'Working in Excel 2000-2016 Dim i As Long On Error Resume Next For i = 1 To 3 WB.SendMail stRecipient, stSubject, True If Err.Number = 0 Then Exit For Next i OutlookExpressSend = Err.Number = 0 End Function
Наконец то появилось время вернуться к этой теме. Матраскин, SLAVICK, Спасибо большое! Ваши коды работают хорошо. Плюсанул)) Для моих целей более удобным оказался код Ярослава.
Наконец то появилось время вернуться к этой теме. Матраскин, SLAVICK, Спасибо большое! Ваши коды работают хорошо. Плюсанул)) Для моих целей более удобным оказался код Ярослава.pabchek
"Учиться, учиться и еще раз учиться!" WM: R399923528092
Сообщение отредактировал pabchek - Среда, 01.06.2016, 11:43