/ 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.