Microsoft 365 Erreur Automation : L'objet invoqué s'est déconnecté de ses clients

CYNO68

XLDnaute Junior
Bonjour
j'utilise une macro qui mer permet de convertir un bon de commande EXCEL en PDF et de l'envoyer par mail depuis plusieurs années et sur plusieurs postes différents
Elle fonctionne très bien sauf sur le poste d'un de mes collaborateurs et je n'arrive pas à comprendre pourquoi
Ci dessous le message qui s'affiche quand on exécute la macro
1649754188874.png


Le code bloque à cet endroit

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=CurFile, Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas _
:=False, OpenAfterPublish:=False



Pouvez vous m'aider à comprendre ce qu'il peut se passer sur ce poste ?
car quand j'exécute cette macro sur mon PC cela fonctionne correctement

Vous trouverez ci dessous le code entier

Sub ENVOI_COMMANDE()
' Nécessite la référence : Microsoft Outlook 1x Object Library


'Dim olMail As Outlook.MailItem
'Dim olApp As New Outlook.Application
Dim olApp As Object
Dim oLMail As Object
'Dim olMailItem As Object
Const olMailItem As Long = 0 ' permet d'eviter d'utiliser outlook object library

Dim CurFile As String
Dim FeuillePrecedente As String
Dim RR As String
Dim Nom_Commercial As String
Dim Numero_Semaine As String

Dim BdcEXCEL As String





Set olApp = CreateObject("Outlook.Application") ' New Outlook.Application

Set oLMail = olApp.CreateItem(olMailItem)



CurFile = ThisWorkbook.Path & "\COMMANDES MAIL\" & [G1].Value & " " & [P14].Value & "." & [P15].Value & "." & [P16].Value & " " & [K9].Value & " " & "Code Client" & " " & [K7].Value & ".pdf"
'Bon de commande PDF

BdcEXCEL = ThisWorkbook.Path & "\COMMANDES MAIL\" & [G1].Value & " " & [P14].Value & "." & [P15].Value & "." & [P16].Value & " " & [K9].Value & " " & "Code Client" & " " & [K7].Value & ".xlsx"
'Bon de commande EXCEL

Range("A17:O119").Select
Application.CutCopyMode = False
Selection.Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "commande version excel"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("C:C").Select
Selection.NumberFormat = "0000000000000"
Sheets("commande version excel").Select

Application.CutCopyMode = False
Sheets("commande version excel").Move
ChDir ThisWorkbook.Path & "\COMMANDES MAIL\"
ActiveWorkbook.SaveAs Filename:= _
BdcEXCEL, FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False


ActiveWindow.Close



ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=CurFile, Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas _
:=False, OpenAfterPublish:=False



Nom_Commercial = [A14].Value


'selectionner ADV en fonction du commercial

If Nom_Commercial = "VINCENT" Or Nom_Commercial = "THOMAS" Or Nom_Commercial = "SOIG" Or Nom_Commercial = "CLEMENT" Or Nom_Commercial = "MARIANNE" Then

RR = ""
End If

If Nom_Commercial = "BIXENTE" Or Nom_Commercial = "HELENE" Or Nom_Commercial = "GILLES" Or Nom_Commercial = "YOANN" Then
RR = ""
End If

If Nom_Commercial = "SIMON" Or Nom_Commercial = "FRANCK" Or Nom_Commercial = "SEBASTIEN" Or Nom_Commercial = "SYLVIE" Or Nom_Commercial = "OLIVIER" Or Nom_Commercial = "GUILLAUME" Then

RR = ""
End If


With oLMail

'determiner adresse d'envoi principale
.To = RR
' qui en copie
'.CC = ""
' qui en copie cachée
'.BCC = ""
'Objet du mail
.Subject = [G1].Value & " " & [P14].Value & "." & [P15].Value & "." & [P16].Value & " " & [K9].Value & " " & "Code Client" & " " & [K7].Value

'Texte
.Body = "Bonjour," & vbCrLf & vbCrLf & "Ci joint une nouvelle Offre/Commande " & vbCrLf & vbCrLf & "Merci" & vbCrLf & "Bonne journée" & vbCrLf & vbCrLf & [B14].Value

'Piece jointe
.Attachments.Add CurFile
.Attachments.Add BdcEXCEL


'Envoyer

.Display

End With

'MsgBox "Merci d'avoir envoyé votre RAPPORT !!!"


' Effacer les variables objets
Set oLMail = Nothing
Set olApp = Nothing

End Sub

 

fanch55

XLDnaute Barbatruc
Bonjour,
La macro a été simplifiée et optimisée, regardez le code .
Si elle ne fonctionne pas sur le poste de votre collaborateur,
il est probable que le dossier \COMMANDES MAIL\ n'existe pas sur celui-ci .

Sinon, capturez le message d'erreur et communiquez le moi .

VB:
Sub ENVOI_COMMANDE()
Dim Mail            As Object
Dim Document        As String
Dim Rootfile        As String
Dim PdfFile         As String
Dim XlsFile         As String
Dim RR              As String

    Document = [G1].Value & " " & [P14].Value & "." & [P15].Value & "." & [P16].Value & " " & [K9].Value & " " & "Code Client" & " " & [K7].Value
    Rootfile = ThisWorkbook.Path & "\COMMANDES MAIL\" & Document
    PdfFile = Rootfile & ".pdf"  'Bon de commande PDF
    XlsFile = Rootfile & ".xlsx" 'Bon de commande EXCEL
    
    Application.CutCopyMode = False
        [A17:O119].Copy
        With Worksheets.Add(, ActiveSheet)
            .Name = "commande version excel"
             ActiveCell.PasteSpecial Paste:=xlPasteValues
            .Columns("C").NumberFormat = "0000000000000"
            .Move
        End With
    Application.CutCopyMode = False

    Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Filename:=XlsFile, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile
        ActiveWindow.Close
    Application.DisplayAlerts = True

    'selectionner ADV en fonction du commercial
    Select Case [A14].Value
        Case "VINCENT", "THOMAS", "SOIG", "CLEMENT", "MARIANNE": RR = ""
        Case "BIXENTE", "HELENE", "GILLES", "YOANN": RR = ""
        Case "SIMON", "FRANCK", "SEBASTIEN", "SYLVIE", "OLIVIER", "GUILLAUME": RR = ""
    End Select

    Set Mail = CreateObject("Outlook.Application").CreateItem(olMailItem)
        With Mail
            .To = RR ' destinataire
            '.CC = "" ' en copie
            '.BCC = "" ' en copie cachée
            'Objet du mail
            .Subject = Document
            'Texte
            .Body = "Bonjour," & vbLf & vbLf & _
                    "Ci joint une nouvelle Offre/Commande " & vbLf & vbLf & _
                    "Merci" & vbLf & _
                    "Bonne journée" & vbLf & vbLf & _
                    [B14].Value
        
            'Pieces jointes
            .Attachments.Add PdfFile
            .Attachments.Add XlsFile
        
            .Display ' or .send
        
        End With
    Set Mail = Nothing
'MsgBox "Merci d'avoir envoyé votre RAPPORT !!!"

End Sub
 

Discussions similaires

Statistiques des forums

Discussions
299 728
Messages
1 978 781
Membres
206 388
dernier inscrit
Bpotill