更改保存到文件夹

时间:2019-12-23 08:46:03

标签: vba outlook

如何在下面的VBA代码中包含“浏览文件夹”选项。

当前,它将默认文件夹显示为“ C:\ Admin \ JV批准备份”。如果用户要保存在其他文件夹中,则需要输入以选择该文件夹。

Sub SaveItem(olItem As MailItem)
    'An Outlook macro by Graham Mayor - www.gmayor.com
    Dim fname As String
    Dim fPath As String
    Dim JVvalue As Variant

    fPath = "C:\Admin\JV Approval Backup"

    fPath = InputBox("Enter the path to save the message." & vbCr & _
                     "The path will be created if it doesn't exist.", _
                     "Save Message", fPath)
    CreateFolders fPath

    JVvalue = InputBox("Enter the JV No")

    If olItem.Sender Like "*@gmayor.com" Then    'Your domain
        fname = JVvalue & "  " & Chr(32) & olItem.SenderName & "   " & _
          Format(olItem.SentOn, "mmmm" & "   " & "YYYY-MM-DD") & Chr(32) & _
          Format(olItem.SentOn, "HH.MM") & "    " & "     " & olItem.Subject
    Else
        fname = JVvalue & "   " & Chr(32) & olItem.SenderName & "   " & _
          Format(olItem.ReceivedTime, "mmmm" & "   " & "YYYY-MM-DD") & Chr(32) & _
          Format(olItem.ReceivedTime, "HH.MM") & "    " & "    " & olItem.Subject
    End If
    fname = Replace(fname, Chr(58) & Chr(41), "")
    fname = Replace(fname, Chr(58) & Chr(40), "")
    fname = Replace(fname, Chr(34), "-")
    fname = Replace(fname, Chr(42), "-")
    fname = Replace(fname, Chr(47), "-")
    fname = Replace(fname, Chr(58), "-")
    fname = Replace(fname, Chr(60), "-")
    fname = Replace(fname, Chr(62), "-")
    fname = Replace(fname, Chr(63), "-")
    fname = Replace(fname, Chr(124), "-")
    SaveUnique olItem, fPath, fname
lbl_Exit:
    Exit Sub
End Sub

0 个答案:

没有答案