Есть ли диалог SaveAs? - PullRequest
Новая
       37

Есть ли диалог SaveAs?

2 голосов
/ 16 февраля 2011

Я хочу сохранить вложение с помощью файла SaveAs.Возможно ли это сделать с помощью VBA и Outlook?

Ответы [ 3 ]

1 голос
/ 08 января 2015

Не забудьте функцию BrowseForFolder: 

Function BrowseForFolder(Optional OpenAt As String) As String 

Dim ShellApp As Object 

Set ShellApp = CreateObject("Shell.Application"). _ 
BrowseForFolder(0, "Please choose a folder", 0, OpenAt) 

On Error Resume Next 
BrowseForFolder = ShellApp.self.Path 
On Error GoTo 0 

Select Case Mid(BrowseForFolder, 2, 1) 
Case Is = ":" 
    If Left(BrowseForFolder, 1) = ":" Then 
        BrowseForFolder = "" 
    End If 
Case Is = "\" 
    If Not Left(BrowseForFolder, 1) = "\" Then 
        BrowseForFolder = "" 
    End If 
Case Else 
    BrowseForFolder = "" 
End Select 

ExitFunction: 

Set ShellApp = Nothing 

End Function
1 голос
/ 18 февраля 2011

Я не думаю, что Outlook позволит вам открыть диалоговое окно файла!

Уродливый, но быстрый и функциональный обходной путь, который я использовал, заключается в том, чтобы временно открыть экземпляр Excel и использовать его метод GetSaveAsFilename. 

Set xlApp = CreateObject("Excel.application")
xlApp.Visible = False
strSaveAsFilename = xlApp.GetSaveAsFilename
xlApp.Quit
Set xlApp = Nothing

Тогда вы можете сказать MyAttachment.SaveAsFile(strSaveAsFilename).

Если Excel не обязательно установлен, то вы можете сделать аналогичный трюк, используя Word и метод FileDialog (Word не имеет GetSaveAsFilename). См. Справку VBA на FileDialog для примера.

Возможно, есть более элегантное решение, но вышеприведенное сработает ...

0 голосов
/ 06 июля 2012

Есть два способа смоделировать это поведение (я предполагаю, что Outlook 2003 здесь):

Использовать файл "Сохранить вложения"

Этот код вызовет программный пункт меню «Сохранить вложения» в меню «Файл». Три вспомогательных функции ниже необходимы и должны быть вставлены в один и тот же проект. Выберите или откройте письмо с вложениями и выполните процедуру SaveAttachments. 

Sub SaveAttachments()

Dim obj As Object
Dim msg As Outlook.mailItem
Dim insp As Outlook.Inspector

Set obj = GetCurrentItem
If TypeName(obj) = "MailItem" Then
  Set msg = obj
  Set insp = msg.GetInspector
  With insp
    .Display
    ' execute the File >> Save Attachments control
    .CommandBars.FindControl(, 3167).Execute
    .Close olDiscard ' or olPromptForSave, or olSave
  End With
End If

End Sub

Function GetCurrentItem() As Object
  Select Case True
  Case IsExplorer(Application.ActiveWindow)
    Set GetCurrentItem = ActiveExplorer.Selection.item(1)
  Case IsInspector(Application.ActiveWindow)
    Set GetCurrentItem = ActiveInspector.CurrentItem
  End Select
End Function
Function IsExplorer(itm As Object) As Boolean
  IsExplorer = (TypeName(itm) = "Explorer")
End Function
Function IsInspector(itm As Object) As Boolean
  IsInspector = (TypeName(itm) = "Inspector")
End Function

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

save attachments with multiple files

Использовать BrowseForFolder

Я использую функцию BrowseForFolder из VBAX . Откроется диалоговое окно BrowseForFolder для Shell.Application:

shell app browse for folder

Выберите или откройте электронное письмо с вложениями и выполните процедуру SaveAttachments. После выбора папки в диалоговом окне все вложения в электронное письмо будут сохранены в выбранной папке. 

Sub SaveAttachments()

  Dim folderToSave As String
  Dim obj As Object
  Dim msg As Outlook.mailItem
  Dim msgAttachs As Outlook.attachments
  Dim msgAttach As Outlook.Attachment

  folderToSave = BrowseForFolder

  If folderToSave <> "False" Then

    Set obj = GetCurrentItem
    If TypeName(obj) = "MailItem" Then
      Set msg = obj
      Set msgAttachs = msg.attachments

      For Each msgAttach In msgAttachs
        msgAttach.SaveAsFile folderToSave & "\" & msgAttach.FileName
      Next msgAttach
    End If

  End If

End Sub

Function GetCurrentItem() As Object
  Select Case True
  Case IsExplorer(Application.ActiveWindow)
    Set GetCurrentItem = ActiveExplorer.Selection.item(1)
  Case IsInspector(Application.ActiveWindow)
    Set GetCurrentItem = ActiveInspector.CurrentItem
  End Select
End Function
Function IsExplorer(itm As Object) As Boolean
  IsExplorer = (TypeName(itm) = "Explorer")
End Function
Function IsInspector(itm As Object) As Boolean
  IsInspector = (TypeName(itm) = "Inspector")
End Function
...