DominoArea.org [Archive]

Même script que chez IBM mais traduit en FR (source = http://www-1.ibm.com/support/docview.wss?rs=463&context=SSKTMJ&context=SSKTWP&dc=DA490&dc=DB520&dc=DA4A30&dc=DB530&dc=DA480&dc=D700&dc=DB500&dc=D400&dc=D600&dc=DA400&dc=D420&dc=DA4A10&dc=D410&dc=DA4A20&dc=DA460&dc=DA440&dc=DA430&dc=DA470&dc=DB550&dc=D430&dc=DA420&dc=DA500&dc=DA410&dc=DB540&dc=DB510&q1=how+to+copy+a+folder&uid=swg21110903&loc=en_US&cs=utf-8&lang=en)


J'ai créé un bouton qui lance le LotusScript et pour vous amis du forum le même script traduit en français (IBM c'est bien mais c'est tout en anglais ça gave à force)

Code : Tout sélectionner

       
Sub Click(Source As Button)
   
   Dim s As New NotesSession
   Dim w As New NotesUIWorkspace
   Dim destDb As New NotesDatabase("","")
   Dim sourceDb As New NotesDatabase("","")
   Dim AllDocs As NotesDocumentCollection
   Dim AllDocsView As NotesView
   Dim sourceDoc As NotesDocument
   Dim destDoc As NotesDocument
   Dim tempDoc As NotesDocument
   Dim docCount As Variant
   Dim current As Variant
   Dim choices (0 To 2) As Variant
   
   choices(0) = "Base Notes courante"
   choices(1) = "Autre base Notes locale"
   choices(2) = "Autre Base Notes sur le serveur"
   
' get source database
   sourceDbType = w.Prompt(PROMPT_OKCANCELLIST, "Selection de la base source",  _
   "Selectionner la base Notes que vous voulez copier:", _
   choices(0), choices)
   
   If sourceDbType = "" Then
      Messagebox "Opération annulée"
      Exit Sub
   End If
   
   If sourceDbType = choices(0) Then
      Set sourceDb = s.CurrentDatabase
   Else
      If sourceDbType = choices(1) Then
         sourceDbServer = ""
         sourceDbNameReturn = w.OpenFileDialog(False, _
         "Selection de la base source", "*.nsf", _
         s.GetEnvironmentString("Directory", True))
         If Isempty(sourceDbNameReturn) Then    'Means they hit Cancel
            Msgbox("Opération annulée : impossible de continuer sans un nom de fichier.")
            Exit Sub
         End If
         sourceDbName=SourceDbNameReturn(0)
      Else   
         sourceDbServer = Inputbox("Entrer le nom du serveur Domino")
         sourceDbName = Inputbox("Entrer le nom de fichier de la base (expl : mail/nomdelabase.nsf)")
         If sourceDbName = ""  Then
            Msgbox("Opération annulée : impossible de continuer sans un nom de fichier.")
            Exit Sub
         End If         
      End If
      If Not (sourceDb.Open(sourceDbServer, sourceDbName)) Then
         Msgbox("Impossible de trouver ou ouvrir le fichier: " + sourceDbName)
         Exit Sub
      End If
   End If
   
' get destination database
   destDbType = w.Prompt(PROMPT_OKCANCELLIST, "Selection de la base cible",  _
   "Selectionner la base Notes où vous voulez coller les dossiers et documents", _
   choices(1), choices)
   
   If destDbType = "" Then
      Messagebox "Opération annulée"
      Exit Sub
   End If
   If destDbType = choices(0) Then
      Set destDb = s.CurrentDatabase
   Else
      If destDbType = choices(1) Then
         destDbServer = ""
         destDbNameReturn = w.OpenFileDialog(False, _
         "Selection de la base source", "*.nsf", _
         s.GetEnvironmentString("Directory", True))
         If Isempty(destDbNameReturn) Then  'Means they hit Cancel
            Msgbox("Opération annulée : impossible de continuer sans un nom de fichier.")
            Exit Sub
         End If
         destDbName=destDbNameReturn(0)
      Else
         
         destDbServer = Inputbox("Entrer le nom du serveur Domino")
         destDbName = Inputbox("Entrer le nom de fichier de la base (expl : mail/nomdelabase.nsf)")
         If destDbName = ""  Then
            Msgbox("Opération annulée : impossible de continuer sans un nom de fichier.")
            Exit Sub
         End If
      End If
      If Not (destDb.Open(destDbServer,destDbName)) Then
         Msgbox("Impossible de trouver ou ouvrir le fichier: " + destDbName)
         Exit Sub
      End If
   End If
   
   If destdb.server=sourcedb.server And destdb.filename=sourcedb.filename And destdb.filepath=sourcedb.filepath Then
      Msgbox("La base source et la Base de destination ne peuvent pas être identique")
      Exit Sub
   End If
   
' Build collection of all documents in source database using selection
' formula similar to that used in the Mail templates All Documents view
   AllDocsSelect = "@IsNotMember(""A""; ExcludeFromView) & IsMailStationery != 1" +  _
   "& Form != ""Group"" & Form != ""Person"""
   Set AllDocs = sourceDb.Search(AllDocsSelect, Nothing, 0)
   
 ' display progress
   docCount = AllDocs.Count
   current = 0
   Print Cstr(Round(current / docCount * 100, 0)) + "% copied"
   
' step through each folder in source database except system folders other than Inbox
   Forall folder In sourceDb.Views
      If folder.IsFolder And (Instr(1, folder.Name, "(", 0)<>1 Or folder.Name="($Inbox)") Then
         
' The following code ensures that folders with no docs in them still get copied
'  so that any folder design customizations are kept
         Set destFolder = destDb.GetView(folder.Name)
         If destFolder Is Nothing Then
            Set sourceFolder = sourceDb.GetDocumentByUNID(folder.UniversalID)
            Call sourceFolder.CopyToDatabase(destDb)
            Set destFolder = destDb.GetView(folder.Name)
            If destFolder Is Nothing Then
               Msgbox("Impossible de créer un dossier dans la nouvelle Base.")
               Exit Sub
            End If
         End If
' cycle through each doc in the current folder
         Set sourceDoc = folder.GetFirstDocument
         While Not (sourceDoc Is Nothing)
            Set destDoc = sourceDoc.CopyToDatabase(destDb)
' copy each document to the same folder in the destination database
            Call destDoc.PutInFolder(folder.Name, True)
' remove document from the collection of docs built from source db all docs view
            Set tempDoc = AllDocs.GetDocument(sourceDoc)
            Set sourceDoc = folder.GetNextDocument(tempDoc)
            Call AllDocs.DeleteDocument(tempDoc)   'remove from collection
' display progress
            current = current + 1
            Print Cstr(Round(current / docCount * 100, 0)) + "% copied"
         Wend
      End If
   End Forall
   
' docs remaining in collection are not in any folder - copy these to dest. db
   Set sourceDoc = AllDocs.GetFirstDocument
   While Not (sourceDoc Is Nothing)
      Call sourceDoc.CopyToDatabase(destDb)
' display progress
      current = current + 1
      Print Cstr(Round(current / docCount * 100, 0)) + "% copied"
      Set sourceDoc = AllDocs.GetNextDocument(sourceDoc)
   Wend
'done
   Msgbox("Les documents ont été copié. Fermez et réouvrez la base de destination (si elle est ouverte) pour que la vue soit actualisée.")
   
   
   
End Sub