هل هناك حوار إنقاذ?

Question

أريد حفظ مرفق البريد مع SaveAs ملف الحوار.هل من الممكن القيام بذلك مع فبا والتوقعات?

Answer 1

لا أعتقد أن أوتلوك ستتيح لك فتح مربع حوار ملف!

الحل القبيح ولكن السريع والوظيفي الذي استخدمته هو فتح مثيل من إكسيل مؤقتا واستخدامه GetSaveAsFilename الطريقة.

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

ثم يمكنك أن تقول MyAttachment.SaveAsFile(strSaveAsFilename).

إذا لم يتم تثبيت إكسيل بالضرورة ، ثم يمكنك القيام خدعة مماثلة باستخدام ورد وطريقة فيليديالوغ (ورد ليس لديها جيتسافيسفيلينام).انظر مساعدة فبا على فيليديالوغ على سبيل المثال.

ربما يكون هناك حل أكثر أناقة هناك ، ولكن ما سبق سوف تعمل...

Answer 2

لا تنسى 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

Answer 3

هناك طريقتان لمحاكاة هذا السلوك (أفترض أوتلوك 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

لاحظ أنه إذا كانت هناك عدة مرفقات ، فسيطلب منك اختيار المرفق(المرفقات) الذي تريد حفظه قبل عرض مربع حوار الحفظ:

استخدام بروزفورفولدر

يمكنني استخدام وظيفة بروزفورفولدر وجدت على فباكس.هذا سوف تظهر قذيفة.الحوار بروزفورفولدر التطبيق:

حدد أو افتح رسالة بريد إلكتروني تحتوي على مرفقات وقم بتشغيل 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