Est-il une boîte de dialogue enregistrer sous?

Question

Je veux enregistrer une pièce jointe à un mail avec un SaveAs boîte de dialogue de fichier.Est-il possible de faire cela avec VBA et Outlook?

Answer 1

Je ne pense pas que Outlook vous permet d'ouvrir une boîte de dialogue de fichier!

Un laid, mais rapide et fonctionnelle de la solution de contournement que j'ai utilisé est temporairement ouvrir une instance d'Excel et l'utilisation de son GetSaveAsFilename la méthode.

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

Alors vous pouvez dire MyAttachment.SaveAsFile(strSaveAsFilename).

Si Excel n'est pas forcément installé, alors vous pouvez faire une astuce similaire à l'aide de Word et de la méthode FileDialog (Word n'a pas GetSaveAsFilename).Voir l'aide de VBA sur FileDialog pour un exemple.

Il y a probablement une solution plus élégante, mais, de la ci-dessus va travailler...

Answer 2

N'oubliez pas les BrowseForFolder fonction:

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

Answer 3

Il y a deux façons de simuler ce comportement (je suppose Outlook 2003 ici):

Utiliser Le Fichier » Enregistrer Les Pièces Jointes

Ce code va appeler par programme l' "Enregistrer les pièces Jointes" dans le menu, dans le Menu Fichier.Les trois fonctions accessoires ci-dessous sont nécessaires et devraient être collé dans le même projet.Sélectionnez ou ouvrez un e-mail avec des pièces jointes et d'exécuter les SaveAttachments procédure.

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

Notez que si il y a plusieurs pièces jointes, vous serez invité à choisir celle(s) que vous voulez enregistrer avant d'être montrée la boîte de dialogue enregistrer:

Utilisation BrowseForFolder

J'utilise le BrowseForFolder fonction trouvée sur VBAX.Cela permettra de montrer la Coquille.L'Application BrowseForFolder boîte de dialogue:

Sélectionnez ou ouvrez un e-mail avec des pièces jointes et d'exécuter les SaveAttachments procédure.Après avoir sélectionné un dossier dans la boîte de dialogue, toutes les pièces jointes à l'e-mail sera enregistré dans le dossier sélectionné.

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