salut,
j'ai un pb
j'utilise une macro pour envoyer un fichier excel par mail(outlook, directement dans le corps du mail).
depuis mon passage de microsoft lync à skype for business la macro ne fonctionne plus j'ai comme message d'erreur
2147319779 au niveaun de
Code : Sélectionner tout - Visualiser dans une fenêtre à part
With ActiveSheet.MailEnvelope
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
   Sub envoie(Destinataire, copie, sujet, Week, CRP, Expediteur, fichier, DIV)
Dim sem As Integer
Dim Day As Date
'Dim fichier As Variant
Day = Format(Date, "dd mmm yyyy")
sem = Application.WorksheetFunction.WeekNum(Now)
 
'Selection.CurrentRegion.Select
 
ActiveWorkbook.EnvelopeVisible = True
ReturnReceipt = True
 
Set app = CreateObject("Outlook.Application")
Set Item = app.createitem(0)
 
newfilename = "T:\Dept_Pc\planning\historique capa\" & fichier
newfilename1 = "T:\Dept_Pc\planning\historique capa\" & Left(fichier, 7) & "o" & Right(fichier, Len(fichier) - 10)
newfilename2 = "T:\Dept_Pc\planning\historique capa\" & Left(fichier, 7) & "i" & Right(fichier, Len(fichier) - 10)
newfilename3 = "T:\Dept_Pc\planning\historique capa\" & Left(fichier, 7) & "k" & Right(fichier, Len(fichier) - 10)
With ActiveSheet.MailEnvelope
    .Introduction = "Hello," & vbCrLf _
    & vbCrLf _
    & "Please find here below your capacity for W" & Week & ", based on CRP" & CRP & ":" & vbCrLf _
    & vbCrLf _
    & "Thanks for your rapid feedback if there is any issue/needs" & vbCrLf _
    & vbCrLf _
    & "Regards," & vbCrLf _
    & vbCrLf _
    & Expediteur
 
    '.Item.Attachm"bonjour, veuillez trouver ci joint le fichier mis à jour  /  ke"
    .Item.To = Destinataire
    .Item.CC = copie
    .Item.Subject = sujet & Week
    If DIV = "ko" Then
        .Item.Attachments.Add newfilename
        .Item.Attachments.Add newfilename1
        .Item.Attachments.Add newfilename2
        .Item.Attachments.Add newfilename3
    Else
        .Item.Attachments.Add newfilename
    End If
    While Not Continue
        DoEvents
    Wend
    Continue = False
    .Item.Send
End With