<?xml version="1.0" standalone="yes" ?><script uid="{6362F28C-4E91-4E78-9340-D95404A37F7D}" shared="f" desc="Add entry to address book" help="Add sender entry details from the selected message to a personal address book" imglib="access.dli" imgid="105" fav="f" inten="t" vbe="f" created="20011211T170556" smod="20020514T125750" pmod="20020513T132215" lfdn="" rm="t" ver="" author="" amail="" aurl="" acom="" aphone="" comex="f" dxwrn="f"><integrations><integration type="ngw_toolbar" context="GW.CLIENT.WINDOW.BROWSER" event="" seq="b" otherid="" menu="" before="" anchor="an_under"></integration><integration type="ngw_contextmenu" context="GW.CLIENT.WINDOW.BROWSER" event="" seq="b" otherid="" menu="" before="" anchor="an_under"></integration><integration type="ngw_contextmenu" context="GW.MESSAGE.MAIL" event="" seq="b" otherid="" menu="" before="" anchor="an_under"></integration></integrations><source><primary><![CDATA['-------------------------------------------------------------------------------
' Formativ Solutions for GroupWise
' Add entry to Address Book 
' Designed by: Formativ Business Solution Team
' Advansys Corporation (www.advansyscorp.com)
' Version 1.1
'
' Description:
' This applet will add the sender details of a selected email message into an 
' address book of your choice.  If the entry already exists in the address book, 
' a dialog will be displayed allowing you to either 1) replace the existing 
' entry, or 2) select another address book.
' 
' INTEGRATIONS:  GroupWise main toolbar; Mail message toolbar and right context menu.
'-------------------------------------------------------------------------------
'Change the first character with upper Case. 
Const STRING_CAP = TRUE
'-->Flexalock
Dim Dlg
Dim DLG_DISPLAY
HRT = Chr(13) & Chr(10) 
Const CAPTION = "Formativ Business Solutions"


'-------------------------------------------------------------------------------
' Main line processing
'-------------------------------------------------------------------------------
Sub Main(Client, GWEvent)
  
  Dim Cmd 
  Dim Msg
  Dim ECtl
  Dim ZPCtl
  Dim PhCtl
  Dim DptCtl
  Dim OrgCtl
  Dim CntCtl
  Dim GrtCtl
  Dim FaxCtl
  Dim CellCtl
  Dim CityCtl
  Dim AddrCtl
  Dim BookCtl
  Dim FNameCtl
  Dim LNameCtl
  Dim DNameCtl
  Dim ETypeCtl
  Dim TitleCtl
  Dim AddressBooks       
    
  cExit = 999
  cAddEntry = 101
  cIntroDlg = 103
  cCheckField = 105
  
  Cmd = cIntroDlg
  
  If ValidMsg(Msg, Client) Then  
    Do While Cmd <> cExit    
      
      'Introduction Dialog
      If Cmd = cIntroDlg Then
        Call SetupIntroDlg(Msg, AddressBooks, BookCtl, FNameCtl, LNameCtl, DNameCtl, OrgCtl, ECtl, DptCtl, AddrCtl, CityCtl, ZPCtl, CntCtl, CommentCtl, ETypeCtl, GrtCtl, TitleCtl, PhCtl, CellCtl, FaxCtl)
        Select Case Dlg.Execute
          Case Btn1 Cmd = cCheckField
          Case Else Cmd = cExit
        End Select
      End If
    
      'Check fields
      If Cmd = cCheckField Then
        If (FNameCtl.Text = "") Or (LNameCtl.Text = "") Or (DNameCtl.Text = "") Or (ECtl.Text = "") Then
          Call MsgBox ("Please complete the required fields." & HRT &_
          "Enter FirstName/LastName/DisplayName/Email Address to proceed.", 64, CAPTION)        
          Cmd = cIntroDlg     
        ElseIf BookCtl.Text = "" Then 
          Call MsgBox ("Select an address book to continue.", 64, CAPTION)
          Cmd = cIntroDlg
        Else
          Cmd = cAddEntry
        End If           
      End If 
      
      'Add the entry into address book
      If Cmd = cAddEntry Then
        Call AddEntryIntoAB(AddressBooks, BookCtl, FNameCtl, LNameCtl, DNameCtl, OrgCtl, ECtl, DptCtl, AddrCtl, CityCtl, ZPCtl, CntCtl, CommentCtl, ETypeCtl, GrtCtl, TitleCtl, PhCtl, CellCtl, FaxCtl)
        If DLG_DISPLAY Then
          Cmd = cIntroDlg
        Else
          Cmd = cExit
        End If
      End If
               
    Loop    
  Else
    Call MsgBox("Select a message to continue." & HRT &_
    "This applet will add the sender details to your selected address book." , 64, CAPTION)
  End If
  
  Set AddressBooks = Nothing
  
End Sub

'-------------------------------------------------------------------------------
' Add this entry into address book
'-------------------------------------------------------------------------------
Sub AddEntryIntoAB(AddressBooks, BookCtl, FNameCtl, LNameCtl, DNameCtl, OrgCtl, ECtl, DptCtl, AddrCtl, CityCtl, ZPCtl, CntCtl, CommentCtl, ETypeCtl, GrtCtl, TitleCtl, PhCtl, CellCtl, FaxCtl)

  Dim objBook 
  Dim objEntry
  Dim sEntryObj
  Dim entriesObj
  Dim ADD_CONTACT
  Dim sDisplayName
  
  If DNameCtl.Text <> "" Then
    sDisplayName = DNameCtl.Text
  ElseIf (FNameCtl.Text <> "") Or (LNameCtl.Text <> "") Then
    sDisplayName = Trim(FNameCtl.Text + " " + LNameCtl.Text)
  Else
   sDisplayName = ECtl.Text
  End If
  
  Set objBook = AddressBooks.Item(BookCtl.Text)     
  Set sEntryObj = objBook.Object.AddressBookEntries
  
  sFilter = "(<E-Mail Address> MATCHES """ + ECtl.Text + """)" 
  
  On Error Resume Next  
  Set entriesObj = sEntryObj.Find(sFilter)
  If entriesObj.Count > 0 Then
    Call SetupDlg("Do you want to replace?", "' " & ECtl.Text & "' exists in " &_
    "the selected address book. Do you want to replace?")
    Select Case Dlg.Execute
      Case Btn1       
        ADD_CONTACT = TRUE
        Set aEntry = entriesObj.Item(1) 
        aEntry.Delete
        Set aEntry = Nothing      
      Case Else
        ADD_CONTACT = FALSE
        DLG_DISPLAY = TRUE
    End Select    
  Else
    ADD_CONTACT = TRUE
  End If  
  
  'Add the contact into address book
  If ADD_CONTACT Then
    Set objEntry = objBook.AddContact(sDisplayName)        
    With objEntry
      .FirstName = FNameCtl.Text
      .LastName = LNameCtl.Text
      .DisplayName = DNameCtl.Text
      .Organization = OrgCtl.Text
      .EmailAddress = ECtl.Text  
      .EmailType = ETypeCtl.Text
      .Department = DptCtl.Text      
      .Greeting = GrtCtl.Text
      .Title = TitleCtl.Text
      .Address = AddrCtl.Text
      .State = CityCtl.Text
      .ZipCode = ZPCtl.Text
      .Country = CntCtl.Text
      .CellPhone = CellCtl.Text
      .FaxPhone = FaxCtl.Text
      .OfficePhone = PhCtl.Text
      .Comments = CommentCtl.Text
    End With    
    Set objEntry = Nothing  
    Call MsgBox("Entry added into the '" & BookCtl.Text & "' Address Book.", 64, CAPTION)
  End If
  
  
  ' If the organization name exists, then remove any new names
  sFilter = "(<Name> MATCHES """ + OrgCtl.Text + """)"   
  Set OrganizationsObj = sEntryObj.Find(sFilter)
  if OrganizationsObj.count > 1 then
    for x = 1 to (OrganizationsObj.count -1)
      set iOrgObject = OrganizationsObj.Item(x)
      if iOrgObject.ObjType = fgwCompany then
        iOrgObject.Delete
      end if
      set iOrgObject = nothing
    next
  end if
    
  Set entriesObj = Nothing
  Set sEntryObj = Nothing 
  Set objBook = Nothing
  set OrganizationsObj = nothing
    
End Sub

'-------------------------------------------------------------------------------
' Check the the type of messages selected
'-------------------------------------------------------------------------------
Function ValidMsg(Msg, Client)

	If Client.ClientState.SelectedMessages.Count > 1 then
    ValidMsg = FALSE
  Else
    On Error Resume Next
    Set Msg = Client.ClientState.CommandMessage
    If Msg is Nothing then
      ValidMsg = FALSE      
    Else      
      ValidMsg = TRUE
    End If
  End If 
   
End Function

'-------------------------------------------------------------------------------
' Get first name
'-------------------------------------------------------------------------------
Function GetFirstName(sDisplayName)
  
  Dim sArray
  
  If (Instr(1, sDisplayName, " ") <> 0) then
    sArray = Split(sDisplayName, " ", -1, 1)
    sFirstName = sArray(0)
  End If
    
  GetFirstName = Trim(sFirstName)
End Function

'-------------------------------------------------------------------------------
' Get last name
'-------------------------------------------------------------------------------
Function GetLastName(sDisplayName)
  
  Dim sArray
  
  If (Instr(1, sDisplayName, " ") <> 0) then
    sArray = Split(sDisplayName, " ", -1, 1)
    For x = 1 To UBound(sArray)
      sLastName = sLastName + " " + sArray(x)
    Next
  End If
    
  GetLastName = Trim(sLastName)
End Function

'-------------------------------------------------------------------------------
' Get the country name
'-------------------------------------------------------------------------------
Function GetCountryName(sName)
  
  Dim sArray
  If (Instr(1, sName, ".") <> 0) then
    sArray = Split(sName, ".", -1, 1)
    sName = sArray(UBound(sArray))
    Select Case UCase(sName)
      Case "AU" sCountryName = "Australia"
      Case "UK" sCountryName = "United Kingdom"
      Case "BD" sCountryName = "Bangladesh"
      Case "CA" sCountryName = "Canada"
      Case "CH" sCountryName = "Switzerland"
      Case "DE" sCountryName = "Germany"      
      Case "DK" sCountryName = "Denmark"
      Case "FI" sCountryName = "Finland"
      Case "FR" sCountryName = "France"
      Case "HK" sCountryName = "Hong Kong"
      Case "HU" sCountryName = "Hungary"
      Case "IN" sCountryName = "India"                  
      Case "IT" sCountryName = "Italy"
      Case "JP" sCountryName = "Japan"
      Case "NZ" sCountryName = "New Zealand"
      Case "NL" sCountryName = "Netherlands"
      Case "NO" sCountryName = "Norway"
      Case "SG" sCountryName = "Singapore"     
      Case "SE" sCountryName = "Sweden"      
      Case "US" sCountryName = "United States"                        
      Case Else sCountryName = ""
    End Select
  End If
    
  GetCountryName = sCountryName
End Function

'-------------------------------------------------------------------------------
' Get organization name
'-------------------------------------------------------------------------------
Function GetOrganizationName(sEmailAddress)
  
  Dim sArray
  
  If (Instr(1, sEmailAddress, "@") <> 0) then
    sArray = Split(sEmailAddress, "@", -1, 1)
    sOrganization = sArray(1)
    If (Instr(1, sOrganization, ".") <> 0) then    
      sArray = Split(sOrganization, ".", -1, 1) 
      sOrganization = sArray(0)
    End If 
  End If
  
  GetOrganizationName = sOrganization
End Function

'-------------------------------------------------------------------------------
' Get display name for the internet mail
'-------------------------------------------------------------------------------
Function GetDisplayName(sDisplayName)
  
  Dim sArray
  
  'Get the email address  
  If (Instr(1, sDisplayName, "<") <> 0) then
    sArray = Split(sDisplayName, "<", -1, 1)
    sDisplayName = sArray(0)
    If sDisplayName = "" Then
      sDisplayName = sArray(1)
      If (Instr(1, sDisplayName, ">") <> 0) then
        sArray = Split(sDisplayName, ">", -1, 1)  
        sDisplayName = sArray(0)
        If (Instr(1, sDisplayName, "@") <> 0) then
          sArray = Split(sDisplayName, "@", -1, 1)    
          sDisplayName = sArray(0)          
        End If      
      End If    
    End If
  End If
  
    
  GetDisplayName = Replace(sDisplayName, ".", " ")  
End Function

'-------------------------------------------------------------------------------
' Get email address
'-------------------------------------------------------------------------------
Function GetEmailAddress(sEmailAddress, sDisplayName)
  
  Dim sArray  
      
  'Get the email address  
  If sEmailAddress = "" Then
    If (Instr(1, sDisplayName, "<") <> 0) then
      sArray = Split(sDisplayName, "<", -1, 1)
      sEmailAddress = sArray(1)  
      If (Instr(1, sEmailAddress, ">") <> 0) then
        sArray = Split(sEmailAddress, ">", -1, 1)
        sEmailAddress = sArray(0)
      End If
    End If            
  End If

  GetEmailAddress = sEmailAddress  
End Function

'-------------------------------------------------------------------------------
' Change first character as upper Case for FirstName, LastName and DisplayName
'-------------------------------------------------------------------------------
Function StringCap(sText)
  
  If Instr(1, sText, " ") Then
    sString = Split(sText, " ", -1, 1)
    sCount = UBound(sString)
    sText = ""
    For sCounter = 0 To sCount
      If (TypeName(sString(sCounter)) = "String") And (Len(sString(sCounter)) > 1) Then
        aStr = sString(sCounter)
        sLftString = Left(aStr, 1)
        sRightString = Right(aStr, Len(aStr)-1)         
        If (sLftString <> "(") Then   
          sText = sText + UCase(sLftString) + LCase(sRightString) + " "
        Else
          sText = sText + sLftString + sRightString
        End If
      Else
        sText = sText + UCase(sString(sCounter)) + " "
      End If             
    Next
  Else
    If (TypeName(sText) = "String") And (Len(sText) > 0) Then
      sText = (sText)
      sLftString = UCase(Left(sText, 1))
      sRightString = Right(sText, Len(sText) -1)    
      sText = UCase(sLftString) + LCase(sRightString)
    End If   
  End If

  StringCap = Trim(sText)
End Function

'-------------------------------------------------------------------------------
' Introduction Dialog
'-------------------------------------------------------------------------------
Function SetupIntroDlg(Msg, AddressBooks, BookCtl, FNameCtl, LNameCtl, DNameCtl, OrgCtl, ECtl, DptCtl, AddrCtl, CityCtl, ZPCtl, CntCtl, CommentCtl, ETypeCtl, GrtCtl, TitleCtl, PhCtl, CellCtl, FaxCtl)
  
  Dim sArray
  
  Dim StatusDlg
  
  On Error Resume Next    
  Set StatusDlg = Utilities.NewStatusDialog    
  With StatusDlg
    .Title = "Initializing applet"
    .MainText = "Scanning for Address Books..."     
    .Show
  End With
        
  Set AddressBooks = GroupWise.AddressBooks

  StatusDlg.MainText = "Extracting fields..."    
      
  Set Dlg = Utilities.NewControlBoxDialog
  With Dlg
   .AutoSize = TRUE
   .VertScrollBar = TRUE
   .Caption = CAPTION
   .Button1Caption = "&Next >>"
   .Title = "Add entry to Address Book"
   .Description = HRT & "Add the message sender's details into a " &_
   "GroupWise address book."
  End With
  
  ' Display a panel control and text
  Set PNCtl = Dlg.AddPanelControl
  With PNCtl
    .AutoSpace = FALSE
    .SpaceAbove = 10
    .SpaceBelow = 25
    .Height = 25
    .BevelOuter = fbvLowered    
    .Caption = " Sender: " & Msg.FromText
    .Alignment = ftaLeftJustify
    .Font.Size = 9
    .Font.Style = ffsBold
    .Font.Color = fclNavy
  End With  
   
  sDisplayName = Msg.FromText

  sEmailAddress = GetEmailAddress(Msg.Sender.EmailAddress, sDisplayName)
      
  'Get the display name if internet mail
  sDisplayName = GetDisplayName(sDisplayName)
  If STRING_CAP Then
    sDisplayName = StringCap(sDisplayName)
  End If
  
  'Get the first name
  sFirstName = GetFirstName(sDisplayName)
  If STRING_CAP Then  
    sFirstName = StringCap(sFirstName)
  End If
  
  'Get the last name
  sLastName = GetLastName(sDisplayName)
  If STRING_CAP Then
    sLastName = StringCap(sLastName)
  End If
          
  'Get the organization name
  sOrganization = GetOrganizationName(sEmailAddress)
  If STRING_CAP Then  
    sOrganization = StringCap(sOrganization)
  End If
          
  Set FNameCtl = Dlg.AddEditControl
  With FNameCtl
    .Width = 195
    .Caption = "First Name"
    .Hint = "Enter first name"
    .Text = sFirstName
  End With 
        
  Set PN = Dlg.AddPanelControl
  with PN
    .AutoSpace = FALSE
    .Height = -37  
  End With
        
  Set LNameCtl = Dlg.AddEditControl
  With LNameCtl
    .Width = 195  
    .Caption = "Last Name"
    .Hint = "Enter last name"
    .Text = sLastName
    .Left = 230
  End With 

  Set DNameCtl = Dlg.AddEditControl
  With DNameCtl
    .Width = 195   
    .Caption = "Display Name"
    .Hint = "Enter display name"
    .Text = sDisplayName
  End With 
  
  Set PN = Dlg.AddPanelControl
  with PN
    .AutoSpace = FALSE
    .Height = -37  
  End With
    
  Set OrgCtl = Dlg.AddEditControl
  With OrgCtl
    .Width = 195   
    .Caption = "Organization"
    .Hint = "Enter organization"
    .Text = sOrganization
    .Left = 230       
  End With 
  
  Set ECtl = Dlg.AddEditControl
  With ECtl
    .Width = 195    
    .Caption = "Email Address"
    .Hint = "Enter email address"
    .Text = sEmailAddress
  End With 
  
  Set PN = Dlg.AddPanelControl
  with PN
    .AutoSpace = FALSE
    .Height = -37  
  End With
    
  Set DptCtl = Dlg.AddEditControl
  With DptCtl
    .Width = 195    
    .Caption = "Department"
    .Hint = "Enter department"
    .Left = 230    
  End With 

  Set ETypeCtl = Dlg.AddComboBoxControl
  With ETypeCtl
    .Width = 195    
    .Caption = "Email Type"
    .Hint = "Enter email type"
    .ListText = "NGW,INTERNET"
    If (Instr(1, Msg.Sender.DisplayName, "<") <> 0) Or (Instr(1, Msg.Sender.DisplayName, ">") <> 0) Then
      .ItemIndex = 1
    Else
      .ItemIndex = 0
    End If    
  End With 
  
  Set PN = Dlg.AddPanelControl
  with PN
    .AutoSpace = FALSE
    .Height = -37  
  End With
    
  Set GrtCtl = Dlg.AddEditControl
  With GrtCtl
    .Width = 195    
    .Caption = "Greeting"
    .Hint = "Enter greeting"
    .Left = 230    
  End With   
    
  Set TitleCtl = Dlg.AddEditControl
  With TitleCtl
    .Width = 195    
    .Caption = "Title"
    .Hint = "Enter title"
  End With 
  
  Set PN = Dlg.AddPanelControl
  with PN
    .AutoSpace = FALSE
    .Height = -37  
  End With
    
  Set PhCtl = Dlg.AddEditControl
  With PhCtl
    .Width = 195    
    .Caption = "Office Phone"
    .Hint = "Enter office phone"
    .Left = 230    
  End With 
      
  Set CellCtl = Dlg.AddEditControl
  With CellCtl
    .Width = 195    
    .Caption = "Cell Phone"
    .Hint = "Enter cell phone"
  End With 
  
  Set PN = Dlg.AddPanelControl
  with PN
    .AutoSpace = FALSE
    .Height = -37  
  End With
    
  Set FaxCtl = Dlg.AddEditControl
  With FaxCtl
    .Width = 195    
    .Caption = "Fax"
    .Hint = "Enter fax number"
    .Left = 230    
  End With 
        
  Set AddrCtl = Dlg.AddMemoControl
  With AddrCtl
    .Caption = "Address"
    .Height = 40
    .Width = 195   
    .Hint = "Enter address"
  End With   
      
  Set PN = Dlg.AddPanelControl
  with PN
    .AutoSpace = FALSE
    .Height = -57  
  End With
              
  Set CityCtl = Dlg.AddEditControl
  With CityCtl
    .Width = 195    
    .Caption = "State"
    .Hint = "Enter state"
    .Height = 40    
    .Left = 230      
  End With 
  
  Set ZPCtl = Dlg.AddEditControl
  With ZPCtl
    .Width = 195      
    .Caption = "ZIP Code"
    .Hint = "Enter zip code"
  End With       
     
  Set PN = Dlg.AddPanelControl
  with PN
    .AutoSpace = FALSE
    .Height = -37  
  End With
              
  Set CntCtl = Dlg.AddEditControl
  With CntCtl
    .Width = 195      
    .Caption = "Country"
    .Hint = "Enter country"
    .Text = GetCountryName(sEmailAddress)
    .Left = 230      
  End With       
   
  Set CommentCtl = Dlg.AddMemoControl
  With CommentCtl
    .Caption = "Comment"
    .Height = 70
    .ScrollBars = fssVertical
    .Text = "Subject: " & Msg.Subject & HRT & HRT & Msg.BodyText.PlainText
    .Hint = "Enter comment"
  End With   
  
  With StatusDlg
    .ProgressRange = AddressBooks.Count 
    .Title = "Reading address books..."    
    .Show
  End With
        
  'Combo box to display the GroupWise Fields
  Set BookCtl = Dlg.AddComboBoxControl
  With BookCtl
    .Caption = "Select an address book for the new entry"
    .Width = 300
    .Hint = "Select the target address book for the addition of this new entry"
    For Each AddressBook in AddressBooks
      .Items.Add(AddressBook.Name)
      StatusDlg.ProgressPosition = counter
      counter = counter + 1
    Next  
  End With
    
  StatusDlg.Hide
  Set StatusDlg = Nothing
          
End Function

'-------------------------------------------------------------------------------
' Dialog
'-------------------------------------------------------------------------------
Function SetupDlg(sTitle, sDes)

  Set Dlg = Utilities.NewControlBoxDialog
  With Dlg
    .Height = 215
    .Caption = CAPTION
    .Title = sTitle 
    .Description = HRT & sDes & HRT & HRT & "Click 'Ok' to replace or 'Cancel' " &_
    "to return previous screen."   
    .WizardImage = WIZARDIMAGE       
  End With
  
End Function]]></primary><backup/></source></script>