VBScript Move sent mail to non-default folder

Mark White

Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
Hi,
I'm trying to move a sent email from the sent box to an other shared mailbox subfolder.

I can't use VBA as macros are disabled and am finding it difficult to change the GetFolderPath() function to work in VBScript.
Below is how I call it but I'm having trouble converting the VBA code into VBScript...

Does anyone have that functionality that allows traversing the folders that they could share with me?
Cheers
Mark

Dim sTarget, sSubject
Dim olApp, olNS, olMsg, olFldr

sTarget = WScript.Arguments(0)
sSubject = WScript.Arguments(1)

Set olFldr = GetFolderPath(sTarget) '****************

Set olApp = GetObject(,"Outlook.Application")
Set olNS = olApp.getNamespace("MAPI")
For each olMsg in olNS.getDefaultFolder(5).Items
If olMsg.Subject = sSubject Then
olMsg.move olFldr
End If
Next
Set olMsg = nothing
Set olNS = nothing
Set olApp = nothing

WScript.StdOut.WriteLine "Done"
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
This is working here - use "data file display name\folder\subfolder" for the target

Code:
Dim objFolder
Dim sTarget, sSubject, olApp, olNS, olMsg, olFldr, aFolders, fldr, i, objNS, strFolderPath
Set OutApp = GetObject(,"Outlook.Application")
Set objNS = OutApp.GetNamespace("MAPI")

sTarget = WScript.Arguments(0)
sSubject = WScript.Arguments(1)

Set objFolder =  GetFolder(sTarget)
For each olMsg in objNS.getDefaultFolder(5).Items
If olMsg.Subject = sSubject Then
olMsg.move objFolder
End If
Next
msgbox "Done"
Function GetFolder(FolderPath)
 'Dim objFolder

 ' folder path needs to be something like 
  '   "Public Folders\All Public Folders\Company\Sales"
  Dim aFolders
  Dim fldr
  Dim i
  Dim objNS

  On Error Resume Next
  strFolderPath = Replace(FolderPath, "/", "\")
  aFolders = Split(FolderPath, "\")

  'get the Outlook objects
  ' use intrinsic Application object in form script
 
Set OutApp = CreateObject("Outlook.Application") 
Set objNS = OutApp.GetNamespace("MAPI")

  'set the root folder
  Set fldr = objNS.Folders(aFolders(0))

  'loop through the array to get the subfolder
  'loop is skipped when there is only one element in the array
  For i = 1 To UBound(aFolders)
    Set fldr = fldr.Folders(aFolders(i))
    'check for errors
    If Err <> 0 Then Exit Function
  Next
  Set GetFolder = fldr

  ' dereference objects
  Set objNS = Nothing
End Function
 

Mark White

Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
Thanks, Diane, I haven't been able to come back to this site for a couple of days, but I'll give this a go.

Will give you feedback as soon as poss but thanks again.
m
 

Mark White

Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
Brilliant, Diane - works a treat. Thanks you so so much
Mark
 

Lina001

New Member
Outlook version
Outlook 2016 32 bit
Email Account
Exchange Server
I am happy that you find the way to solve your problem.
 

Similar threads

Top