/ Forums / Advansys Formativ / Creating Solutions with Formativ / Create Folder and Copy Current Item / Reply To: Create Folder and Copy Current Item

#6634
Support 1a
Participant

Try this code:

const IDS_MAIN_FOLDER   = "People"
  
'-------------------------------------------------------------------------------
' Main-Line processing
'-------------------------------------------------------------------------------
Sub Main(Client, GWEvent)
 
  dim iMsg 
  dim iFolder    
   
  on error resume next
  Set iMsg = Client.ClientState.CommandMessage
  
  ' Do we have a message selected?
  if not isobject(iMsg) then
    call msgbox("Please select a message to proceed.", vbInformation, "Message Management")
    exit sub    
  end if
  
  
  ' Create the destination folder
  set iFolder = CreateFolder(GetDisplayName(iMsg.FromText))
  
  
  ' Make sure we have the folder
  if iFolder is nothing then
    exit sub
  end if   
 
      
  ' 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
    
End Sub
 
 
 
'-------------------------------------------------------------------------------
' Create the sub folders of the People folder
'-------------------------------------------------------------------------------
function CreateFolder(aName)
  
  set CreateFolder = nothing   
  
  if (len(aName) = 0) then
    exit function
  end if
  
  dim iFolder   
  dim iMainFolder
  
  ' Create the main 'People' folder
  set iMainFolder = CreateMainFolder()
 
  if iMainFolder is nothing then
    exit function
  end if    
      
  ' Create the sub folders under the 'People' folder
  on error resume next
  set iFolder = iMainFolder.folders.ItemByName(aName)
      
  if iFolder is nothing then
    set iFolder = iMainFolder.folders.add(aName)
  end if
  
  set CreateFolder = iFolder
  
  set iFolder = nothing             
  set iMainFolder = nothing  
  
end function
 
 
 

'-------------------------------------------------------------------------------
' Create the 'people' folder which is off the root
'-------------------------------------------------------------------------------
function CreateMainFolder()
  
  dim iFolder
  dim iRootFolders
 
  groupwise.account.refresh  
  set iRootFolders = groupwise.account.RootFolder.folders
  
  on error resume next
  set iFolder = iRootFolders.ItemByName(IDS_MAIN_FOLDER)
      
  if iFolder is nothing then
    set iFolder = iRootFolders.add(IDS_MAIN_FOLDER)
  end if
  
  set CreateMainFolder = iFolder
  
  set iFolder = nothing             
  set iRootFolders = nothing  
  
end function
 
 
 

'-------------------------------------------------------------------------------
' 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

Most of these objects are native Object API. Have a look at the Novell GroupWise Object API documentation, which is linked from the drop down help menu within the Formativ development environment.