При добавлении файла в качестве вложения в Outlook с использованием VBA, как сделать диалоговое окно открытой папки активным окном? - PullRequest
0 голосов
/ 08 июня 2018

ОК, поэтому у меня есть рабочий код, однако браузер для добавления файлов отображается в фоновом режиме.Это не было бы так плохо, но когда это случается, это замораживает перспективы, затрудняя быстрое получение доступа.

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

Option Explicit
Private Sub AttachmentFile()
Dim oLook As Object
Dim oMail As Object
Dim FD As Object
Dim vrtSelectedItem As Variant

    Set oLook = CreateObject("Outlook.Application")
    Set oMail = oLook.CreateItem(0)
    Set FD = Excel.Application.FileDialog(3)

    With oMail

            FD.AllowMultiSelect = True
            FD.Filters.Clear
            FD.Filters.Add "All Files", "*.*"
            FD.InitialFileName = "\\ad\dfs\Shared Data\"

            If FD.Show = True Then
                  For Each vrtSelectedItem In FD.SelectedItems
                  .Attachments.Add vrtSelectedItem
                    Next
            End If
            .Display
    End With
    Set FD = Nothing
    Set oMail = Nothing
    Set oLook = Nothing

End Sub

1 Ответ

0 голосов
/ 16 июля 2018

Хотя в Outlook нет объекта FileDialog, вы можете имитировать нажатие кнопки с помощью ExecuteMso.

Чтобы открыть диалоговое окно вставки файла Outlook, нажмите кнопку AttachFile:

Private Sub ExecuteMso_AttachFile()

    Dim currItem As Object

    On Error Resume Next
    Set currItem = ActiveInspector.currentItem
    On Error GoTo 0

    If currItem Is Nothing Then Set currItem = CreateItem(olMailItem)

    currItem.Display

    ' Hover over the icon that you would add as a button
    ' The IdMso to use in ExecuteMso is the last part of the text displayed.
    ActiveInspector.CommandBars.ExecuteMso ("AttachFile")

End Sub
...