Как стать автором
Обновить

Отправка больших файлов в Microsoft Outlook 2010 с помощью VBA и PHP

Время на прочтение5 мин
Количество просмотров15K
Хочу поделиться способом решения проблемы с отправкой больших файлов в Microsoft Outlook 2010 (я думаю с 2013 прокатит тоже).
Итак, исходные условия:
— MS Exchange Server 2010 — inhouse — админ доступа нет — автор просто пользователь
— Ограничения на общий объем писем 10Мб
— Есть пара Linux web-серверов в своем DMZ и админ доступ к корпоративному интранету
Надо:
— Организовать удобный механизм передачи больших файлов (очень больших)
— Не использовать сторонних провайдеров для хранения информации

Первой мыслью было использования сервисов типа dropbox, точнее их self-hosted аналогов типа ownCloud. Однако, разворачивать это все только для аттачментов показалось неадекватным.

К тому же, как аттачить внутри аутлука все еще непонятно. Тут более подходит вариант с плагинами, типа того что предлагает например YouSendIt и другие подобные сервисы. Выглядит это так: в Outlook появляется кнопочка при клике на которую всплывает окошко сервиса куда и аплоадится наш большой файл вложения, при завершении загрузки генерируется ссылка на него и вставляется в тело письма. Так как сервисами такого типа, и соответсвенно их плагинамы пользоваться мы не можем, будем делать их аналог.

Этап 1. Сервис online file sharing
Это довольно просто, благо есть проекты такого рода с лицензией открытого кода. Я выбрал PLUpload , и установил на один из Linux серверов у нас в DMZ. Скрипты были немного модифицированы а именно:
— запрашивается пароль или проверяется сессия (при поддержке SSO аутентификации) через корпоративный интранет, приблизительно как описано здесь
— при успешной загрузке файла сгенерированный URL на его скачивание добавляется в невидимый элемент txtList (зачем это нужно будет понятно из следующего этапа)
— еще я добавил cron для удаления старых ссылок — в целях экономии дискового пространства

Ограничения на размер зависят от настроек PHP и веб сервера, у себя я поставил лимит 2 Гб на файл (аттачить можно до 10 файлов одновременно).

Этап 2. Клиентская часть
В идеале это должен быть Outlook Plug-in, но насколько я понял плагины делать не так легко и пока на это время тратить не буду…
Вместо этого я сделал обычный VBA проект и прикрутил его к тулбару в Outlook.

Проект состоит из формы на которой размещены:
— стандартная кнопка с заголовком Attach
— стандартный контрол WebBrowser (фактически фрейм IE)

Выглядит это вот так


Дальше идет код этого всего на Visual Basic, заранее извиняюсь если кому то он покажется не comme il faut, я не совсем программист (не VB программист — это точно)

код VBA проекта
Private Sub CommandButton1_Click()
If WebBrowser1.Document.all("txtList").Value = "" Then
MsgBox "No files have been uploaded" + vbNewLine + "Please make sure you click on 'Start upload' and upload is 100% completed"
Else
On Error GoTo MessageACT
Set objMail = Outlook.Application.ActiveInspector.CurrentItem
 If objMail.BodyFormat = olFormatHTML Then
 '   objMail.HTMLBody = objMail.HTMLBody + "<hr>Attached" + Attachment1
 incMess = ""
 Attachment1 = WebBrowser1.Document.all("txtList").Value
Expires1 = WebBrowser1.Document.all("txtDate").Value
preText = "<font size=1>------------------------------------</font><br><b>Large Attachments</b><br>" + vbNewLine
posttext = vbNewLine + "<br><font size=1>Attachments added via filesharingserverindmz.cool  <br> powered by owners </font><br>-------------------"
filesAtt = Split(Attachment1, "|")
For Each itm In filesAtt
If itm <> "" Then
    ATTmsg = ATTmsg + "<a href='https://filesharingserverindmz.cool/get/" + itm + "'>https://filesharingserverindmz.cool/get/" + itm + "</a><br>" + vbNewLine
    End If  
Next itm
incMess = preText + ATTmsg + vbNewLine + "<br>the attachments will be valid for <b>" + Expires1 + "</b> days from now" + vbNewLine + posttext
objMail.HTMLBody = vbNewLine + incMess + objMail.HTMLBody
      Else
  incMess = ""
 Attachment1 = WebBrowser1.Document.all("txtList").Value
Expires1 = WebBrowser1.Document.all("txtDate").Value
preText = "------------------------------------" + vbNewLine + " Large Attachments " + vbNewLine
posttext = vbNewLine + " Attachments added via filesharingserverindmz.cool  " + vbNewLine + "powered by owners " + vbNewLine + "------------------------------------"
filesAtt = Split(Attachment1, "|")
For Each itm In filesAtt
If itm <> "" Then
    ATTmsg = ATTmsg + "https://filesharingserverindmz.cool/get/" + itm + vbNewLine
    End If
    
Next itm

incMess = preText + ATTmsg + vbNewLine + "the attachments will be valid for " + Expires1 + " days from now" + vbNewLine + posttext
objMail.Body = vbNewLine + incMess + objMail.Body
End If
Unload Me
End If
Exit Sub
MessageACT:
MsgBox "This button only works when composing email messages"
End Sub
Private Sub CommandButton2_Click()
incMess = ""
 Attachment1 = WebBrowser1.Document.all("txtList").Value
Expires1 = WebBrowser1.Document.all("txtDate").Value
preText = "------------------------------------<br><b>Large Attachments</b><br>" + vbNewLine
posttext = vbNewLine + "<br><font size=1>Attachments added via filesharingserverindmz.cool  <br> powered by UNICEF Geneva ITSSD </font><br>------------------------------------"
filesAtt = Split(Attachment1, "|")
For Each itm In filesAtt
If itm <> "" Then
    ATTmsg = ATTmsg + "<a href='https://filesharingserverindmz.cool/get/" + itm + "'>https://filesharingserverindmz.cool/get/" + itm + "</a><br>" + vbNewLine
    End If   
Next itm
incMess = preText + ATTmsg + vbNewLine + "<br>the attachments will be valid for <b>" + Expires1 + "</b> days from now" + vbNewLine + posttext
LargeAttachments.WebBrowser1.Document.Body.innerHTML = "<body><font style='font-size:11px'>" + incMess + "</font></body>"
LargeAttachments.Show
End Sub
Private Sub CommandButton3_Click()
WebCode1.Visible = True
CommandButton2.Visible = True
CommandButton1.Visible = False
WebBrowser1.Visible = False
WebCode1.Navigate2 "https://filesharingserverindmz.cool/uploader/upload/plugin/upload.php"
incMess = ""
Attachment1 = WebBrowser1.Document.all("txtList").Value
Expires1 = WebBrowser1.Document.all("txtDate").Value
preText = "------------------------------------<br><b>Large Attachments</b><br>" + vbNewLine
posttext = vbNewLine + "<br><font size=1>Attachments added via filesharingserverindmz.cool  <br> powered by UNICEF Geneva ITSSD </font><br>------------------------------------"
filesAtt = Split(Attachment1, "|")
For Each itm In filesAtt
If itm <> "" Then
    ATTmsg = ATTmsg + "<a href='https://filesharingserverindmz.cool/get/" + itm + "'>https://filesharingserverindmz.cool/get/" + itm + "</a><br>" + vbNewLine
    End If  
Next itm
incMess = preText + ATTmsg + vbNewLine + "<br>the attachments will be valid for <b>" + Expires1 + "</b> days from now" + vbNewLine + posttext
WebCode1.Document.Body.innerHTML = "<html><body><font style='font-size:11px'>" + incMess + "</font></body></html>"
WebCode1.SetFocus
End Sub
Private Sub UserForm_Activate()
LargeAttachments.WebBrowser1.Navigate2 "about:blank"
WebBrowser1.Navigate2 "https://filesharingserverindmz.cool/uploader/upload/plugin/upload.php"
End Sub



в коде выше
— filesharingserverindmz.cool — домен на котором хостится PHP скрипт PLUpload-a
— CommandButton1 — кнопка Attach
— WebBrowser1 — контрол WebBrowser
— LargeAttachments — имя формы

Далее создаем модуль, и вставляем туда вот это:
Sub Attachment()
LargeAttachments.Show
End Sub


Далее подключаем этот макрос к тулбару в виде кнопки (внимание! к тулбару который появляется при создании письма, а не к общему)
Получается что то вроде такого:


Использовать довольно удобно, вот видео примера:




И еще, это не готовое решение и для реализации надо существенно допиливать. Целью статьи было показать саму идею и проиллюстрировать примером реализации
Теги:
Хабы:
+2
Комментарии5

Публикации

Изменить настройки темы

Истории

Ближайшие события

Weekend Offer в AliExpress
Дата20 – 21 апреля
Время10:00 – 20:00
Место
Онлайн
Конференция «Я.Железо»
Дата18 мая
Время14:00 – 23:59
Место
МоскваОнлайн