Sending worksheet via Lotus Notes

**Sibrulottes** · 10-04-2013, 08:42 AM

Hi,
so I'm applying different advanced filters to cellular data, and sending reports to 3 different layers of managers in the organisation. I'm running the same loop on 3 different colomns of a manager list. The macro runs great until it stops at various points in the list at .Send 0, vaRecipients

Which is usualy what would happen if the vlookup function retrieving the email returned nothing. Would somebody care to help me figure it out? I'll gladly send you a copy of the file, but won't post it publicly since it holds sensitive info.

Sub envois()
'
' envois Macro
'

'

Dim lLR As Long
Dim BRange As Range
Dim FRange As Range
Dim BCell As Range
Dim Email As String
Dim emaillist As Worksheet
Dim gestionnaires As Worksheet
Set emaillist = ActiveWorkbook.Sheets("email")
Set gestionnaires = ActiveWorkbook.Sheets("Gestionnaires")

Const EMBED_ATTACHMENT As Long = 1454



Dim stFileName As String
  Dim vaRecipients As Variant
 
  Dim noSession As Object
  Dim noDatabase As Object
  Dim noDocument As Object
  Dim noEmbedObject As Object
  Dim noAttachment As Object
  Dim stAttachment As String





'Débuter la boucle pour les récipiendaires 2

With Sheets("Gestionnaires")
    lLR = .Range("B" & .Rows.Count).End(xlUp).Row
    Set BRange = .Range("B2:B" & lLR)
    For Each BCell In BRange
        If BCell.Value <> "" Then
            Debug.Print BCell.Value
             BCell.Copy
    Sheets("Gestionnaires").Select
    Range("F2").Select
    ActiveSheet.Paste
        
     'Nettoyer la feuille de filtre
        
    Sheets("filtre").Select
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
        
    'nettoyer la feuille de données temporaires

Sheets("Tempdata").Select
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.ClearContents
    
    'Filtrer les utilisateurs pour le récipiendaire 2
    
    Sheets("utilisateurs").Select
    Range("D1").Select
    Application.CutCopyMode = False
    Range("A1:F500").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Sheets("Gestionnaires").Range("E1:H2"), Unique:=False
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
    'Coller les numéro de téléphone des utilisateurs reliés au récipiendaire 2 dans le filtre
    
    Sheets("filtre").Select
    Range("A1").Select
    ActiveSheet.Paste
    
    'Filtrer les données pour les utilisateurs reliés au récipiendaire 2
    
    With Sheets("filtre")
    lLR = .Range("A" & .Rows.Count).End(xlUp).Row
    Set FRange = .Range("A2:A" & lLR)
    
    
    Sheets("Data").Select
    Application.CutCopyMode = False
    Range("A1:BM50000").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Sheets("filtre").Range("filtre"), Unique:=False
        End With
        
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    
   'coller à la feuille de données temporaire pour le tableau croisé dynamique et rafraichir le tableau
   
    Sheets("TempData").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("Utilisation cellulaire").Select
    Range("A13").Select
    Application.CutCopyMode = False
    ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotCache.Refresh
  
  'Copier la feuille
With ActiveSheet
    .Copy
  End With
  
 'Nommer le chemin d'accès pour el fichier ainsi que le fichier
 
  stAttachment = "G:\finmois\PDF" & "\" & "Utilisation cellulaire" & ".xls"
 
 ' sauvegarder le fichier temporaire
 
 With ActiveWorkbook
    .SaveAs stAttachment
    .Close
  End With
  
  'Déterminer la valeur du champ appliqué comme récipiendaire dans Lotus Notes
  
Email = Application.WorksheetFunction.VLookup(gestionnaires.Range("F2"), emaillist.Range("A2:B500"), 2, False)
vaRecipients = VBA.Array(Email)

'Ouvrire Lotus notes et créer un courriel

 Set noSession = CreateObject("Notes.NotesSession")
  Set noDatabase = noSession.GETDATABASE("", "")
  If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
 Set noDocument = noDatabase.CreateDocument
  Set noAttachment = noDocument.CreateRichTextItem("stAttachment")
  Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)

'Donner les paramètres au courriel
 With noDocument
    .Form = "Memo"
    .SendTo = vaRecipients
    .CopyTo = vaCopyTo
    .Subject = stSubject
    .Body = vaMsg
    .SaveMessageOnSend = True
    .PostedDate = Now()
    .Send 0, vaRecipients
  End With
 Kill stAttachment
 
  'relâcher les objets de la mémoire.
  Set noEmbedObject = Nothing
  Set noAttachment = Nothing
  Set noDocument = Nothing
  Set noDatabase = Nothing
  Set noSession = Nothing
  
      
    
  Else
            Exit For
        End If
        
        
    Next BCell
End With
    
    
 'Nettoyer la feuille de gestionnaires
        
    Sheets("Gestionnaires").Select
    Range("F2").Select
    Selection.ClearContents
    
'Débuter la boucle pour les récipiendaires 3

With Sheets("Gestionnaires")
    lLR = .Range("C" & .Rows.Count).End(xlUp).Row
    Set BRange = .Range("C2:C" & lLR)
    For Each BCell In BRange
        If BCell.Value <> "" Then
            Debug.Print BCell.Value
             BCell.Copy
    Sheets("Gestionnaires").Select
    Range("G2").Select
    ActiveSheet.Paste
        
     'Nettoyer la feuille de filtre
        
    Sheets("filtre").Select
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
        
    'nettoyer la feuille de données temporaires

Sheets("Tempdata").Select
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.ClearContents
    
    'Filtrer les utilisateurs pour le récipiendaire 3
    
    Sheets("utilisateurs").Select
    Range("E1").Select
    Application.CutCopyMode = False
    Range("A1:F500").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Sheets("Gestionnaires").Range("E1:H2"), Unique:=False
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
    'Coller les numéro de téléphone des utilisateurs reliés au récipiendaire 3 dans le filtre
    
    Sheets("filtre").Select
    Range("A1").Select
    ActiveSheet.Paste
    
    'Filtrer les données pour les utilisateurs reliés au récipiendaire 3
    
    
    
    
    Sheets("Data").Select
    Application.CutCopyMode = False
    Range("A1:BM50000").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Sheets("filtre").Range("filtre"), Unique:=False
       
        
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    
   'coller à la feuille de données temporaire pour le tableau croisé dynamique et rafraichir le tableau
   
    Sheets("TempData").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("Utilisation cellulaire").Select
    Range("A13").Select
    Application.CutCopyMode = False
    ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotCache.Refresh
  
  'Copier la feuille
With ActiveSheet
    .Copy
  End With
  
 'Nommer le chemin d'accès pour el fichier ainsi que le fichier
 
  stAttachment = "G:\finmois\PDF" & "\" & "Utilisation cellulaire" & ".xls"
 
 ' sauvegarder le fichier temporaire
 
 With ActiveWorkbook
    .SaveAs stAttachment
    .Close
  End With
  
  'Déterminer la valeur du champ appliqué comme récipiendaire dans Lotus Notes
  
Email = Application.WorksheetFunction.VLookup(gestionnaires.Range("G2"), emaillist.Range("A2:B500"), 2, False)
vaRecipients = VBA.Array(Email)

'Ouvrire Lotus notes et créer un courriel

 Set noSession = CreateObject("Notes.NotesSession")
  Set noDatabase = noSession.GETDATABASE("", "")
  If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
 Set noDocument = noDatabase.CreateDocument
  Set noAttachment = noDocument.CreateRichTextItem("stAttachment")
  Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)

'Donner les paramètres au courriel
 With noDocument
    .Form = "Memo"
    .SendTo = vaRecipients
    .CopyTo = vaCopyTo
    .Subject = stSubject
    .Body = vaMsg
    .SaveMessageOnSend = True
    .PostedDate = Now()
    .Send 0, vaRecipients
  End With
 Kill stAttachment
 
  'relâcher les objets de la mémoire.
  Set noEmbedObject = Nothing
  Set noAttachment = Nothing
  Set noDocument = Nothing
  Set noDatabase = Nothing
  Set noSession = Nothing
  
      
    
  Else
            Exit For
        End If
        
        
    Next BCell
End With
        
    
     'Nettoyer la feuille de gestionnaires
        
    Sheets("Gestionnaires").Select
    Range("G2").Select
    Selection.ClearContents
       
End Sub

**Sibrulottes** · 10-04-2013, 05:21 PM

If it is any help,

the debugging error message states
Execution error 7000
Notes error: The database already contains a document with this ID (UNID)

Should I have my macro sleep a little after sending one email, so as to give time to Lotus notes to clear the email before excel requests another document?