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
Bookmarks