Public Sub AddPST()
    Dim objApp as Application
    Dim objNS as Namespace
    Dim strPSTFilename as String
    Set objApp = CreateObject("Outlook.Application")
    Set objNS = objApp.GetNamespace("MAPI")
    strPSTFilename = InputBox("Enter the full name and path for a new or existing .PST file", "Add Personal Folders")
    objNS.AddStore strPSTFilename
End Sub