允许用户在执行 VB 脚本时输入保存文件夹路径。该脚本将outlook的附件保存到特定的文件夹路径答案

【问题标题】：Allow user to input save folder path at the time of execution of VB Script. The script save the attachments of outlook to a specific folder path允许用户在执行 VB 脚本时输入保存文件夹路径。该脚本将outlook的附件保存到特定的文件夹路径
【发布时间】：2015-09-08 08:38:09
【问题描述】：

Module SR_Html
    Dim isAttachment As Boolean
    Dim mailBox As Object
    Dim olFolder As Object
    Dim destFolder As Object
    Dim olFolder1 As Object
    Dim fsSaveFolder, sSavePathFS, ssender As String
    Dim objNamespace As Object
    'Dim Msg As Object
    Dim sysDate As Date
    Dim colItems As Object
    Dim colFilteredItems As Object
    Dim intMsgCount As Integer
    Dim objMsg1 As Object
    Dim Msg1 As Object
    Dim intSize As Object

Private Property objOutlook As Object

    Sub Main()

        fsSaveFolder = "C:\Users\naveen.chavali\temp\"

        isAttachment = False

        objOutlook = CreateObject("Outlook.Application")
        objNamespace = objOutlook.GetNamespace("MAPI")
        mailBox = objNamespace.Folders("naveen.chavali@deutschfamily.com")
        olFolder = mailBox.Folders("Inbox")

        destFolder = olFolder.Folders("SRT2 Reports")

        colItems = olFolder.Items
        colFilteredItems = colItems.Restrict("[Unread] =  True")

        If olFolder Is Nothing Then Exit Sub

        sysDate = Date.Today()

        For Each msg In colItems
            If (msg.Subject = "SRT2 Reports HTML" Or msg.Subject = "SRT2 Reports TXT") And msg.Unread = True And (DatePart("yyyy", msg.ReceivedTime) = DatePart("yyyy", sysDate) And DatePart("m", msg.ReceivedTime) = DatePart("m", sysDate) And DatePart("d", msg.ReceivedTime) = DatePart("d", sysDate)) Then
                intSize = intSize + 1
            End If
        Next

        For Each Msg In colItems
            If (Msg.Subject = "SRT2 Reports HTML" Or Msg.Subject = "SRT2 Reports TXT") And Msg.Unread = True And (DatePart("yyyy", Msg.ReceivedTime) = DatePart("yyyy", sysDate) And DatePart("m", Msg.ReceivedTime) = DatePart("m", sysDate) And DatePart("d", Msg.ReceivedTime) = DatePart("d", sysDate)) Then
                intMsgCount = Msg.Attachments.Count
                If intMsgCount > 0 Then
                    For mt As Integer = 1 To intMsgCount
                        'MsgBox("move attachment")
                        sSavePathFS = fsSaveFolder & Msg.Attachments(mt).FileName
                        Msg.Attachments(mt).SaveAsFile(sSavePathFS)
                    Next mt
                    Msg.Unread = False
                End If
            End If
        Next

        For Each msg In colItems
            If (msg.Subject = "SRT2 Reports HTML" Or msg.Subject = "SRT2 Reports TXT") And (DatePart("yyyy", msg.ReceivedTime) = DatePart("yyyy", sysDate) And DatePart("m", msg.ReceivedTime) = DatePart("m", sysDate) And DatePart("d", msg.ReceivedTime) = DatePart("d", sysDate)) Then
                msg.move(destFolder)
                ' msg.Unread = True
            End If
        Next

    End Sub

End Module

fsSaveFolder = "C:\Users\naveen.chavali\temp\" 是此时保存附件的位置。我希望用户输入此路径，脚本应该执行并将附件保存到用户指定的文件夹中。

【问题讨论】：

标题应进一步更正以更准确。

标签： vb.net vba outlook

【解决方案1】：

您可以使用InputBox 或 BrowseForFolder 函数。

  Dim oShell As Object
  Set oShell = CreateObject("Shell.Application")
  Dim save_to_folder  As Object
  Set save_to_folder  = _
  oShell.BrowseForFolder(0, "Please Select a Save Folder:", 1)
  If save_to_folder  Is Nothing Then Exit Sub
 ' Note:  BrowseForFolder doesn't add a trailing slash

【讨论】：