Reply To: Create Folder and Copy Current Item

[Support 1a]

No problems – we always like to try to assist our users. The following code may assist:

dim iMsg 
dim iFolder
  
'-------------------------------------------------------------------------------
' Main-Line processing
'-------------------------------------------------------------------------------
Sub Main(Client, GWEvent)
   
  on error resume next
  Set iMsg = Client.ClientState.CommandMessage
  
  if not isobject(iMsg) then
    call msgbox("Please select a message to proceed.", vbInformation, "Message Management")
    exit sub    
  end if
  
  ' Create the destination folder
  CreateFolder(GetDisplayName(iMsg.FromText))
  
  ' Move the message from the current folder into the destination folder's messages collection
  call Client.ClientState.SelectedFolder.messages.move(iMsg.MessageID, iFolder.Messages)
  
  set iMsg = nothing
  set iFolder = nothing
    
End Sub
 
 
 
 
'-------------------------------------------------------------------------------
' Create the folder if not exists
'-------------------------------------------------------------------------------
sub CreateFolder(aName)
  
  if (len(aName) = 0) then
    exit sub
  end if
  
  dim iRootFolders
 
  groupwise.account.refresh  
  set iRootFolders = groupwise.account.RootFolder.folders
  
  on error resume next
  set iFolder = iRootFolders.ItemByName(aName)
      
  if iFolder is nothing then
    set iFolder = iRootFolders.add(aName)
  end if
               
  set iRootFolders = nothing  
  
end sub
 
 
 

'-------------------------------------------------------------------------------
' Get the sender's display name
'-------------------------------------------------------------------------------
Function GetDisplayName(aName)
  
  Dim iPos
  dim iText
    
  aName = trim(aName)
  iPos = Instr(1, aName, "<", 1)
  
  if (iPos > 0) then
    iText = trim(mid(aName, 1, iPos -1))
    if (len(iText) = 0) then
      aName = mid(aName, iPos + 1)
    else
      aName = iText
    end if
  end if
  
  iPos = Instr(1, aName, ">", 1)
  if (iPos > 0) then
    aName = mid(aName, 1, iPos -1)
  end if
  
  iPos = Instr(1, aName, "@", 1)
  if (iPos > 0) then
    aName = mid(aName, 1, iPos -1)
  end if  
    
  aName = replace(aName, """", "")
  aName = replace(aName, ".", " ")
  aName = replace(aName, "/", "")
  aName = replace(aName, "", "")
  aName = replace(aName, "'", "")
  aName = replace(aName, "*", "")
  aName = replace(aName, ">", "")
  aName = replace(aName, "<", "")
                          
  GetDisplayName = trim(aName)
  
End Function

Regards,

Advansys Support