Envoi de la feuille active via lotus notes

N

N3oTraX

XLDnaute Nouveau
Bonjour,

Depuis la mise à jour de notre version d'office, l'envoi de mes rapports renseignés sous excel ne fonctionnent plus.
Habituellement j'envoi la feuille active pour que mes destinataires ne voient pas les autres feuilles, et depuis j'obtiens une erreur d'exécution 7225 file \Classeur1 not found.

Voici le code que j'utilise (réadapté d'une autre code que j'avais trouvé sur la toile.) :

Code: 
Public Sub Send_OROP(LIST1 As Boolean, LIST2 As Boolean)

    Dim session As Object       'Session Notes
    Dim Dir As Object
    Dim Doc As Object
    Dim AttachME As Object      'Objet richtext
    Dim EmbedObj As Object      'Objet embed du richtext
    Dim Footpage As Object      'pied de page
    Dim Workspace As Object
    Dim EditDoc As Object
    Dim Attachment As String
    Dim cc As String
    Dim time As String
    Dim strChaine As String

'On Error GoTo TraiteErreur
    'Création de la session Notes
    Set Workspace = CreateObject("Notes.NotesUIWorkspace")
    Set session = CreateObject("notes.NOTESSESSION")
    Set Dir = session.GetDatabase("XXX/XXX/XXX", "XXX/XXX/XXX.nsf")
    
    If Not Dir.IsOpen Then Dir.OPENMAIL
    
    'Creation d'un document
    Set Doc = Dir.CreateDocument
    Set AttachME = Doc.CREATERICHTEXTITEM("BODY")
    
    Doc.form = "Memo"
    Doc.Subject = "Rapport OROP de la nuit du " & VBA.Date - 1 & " au " & VBA.Date
    Doc.SendTo = ""
    
    'Initialisation des destinataire en copy par défaut
    If LIST1 = True Then
        strChaine = Sheets("AddressBook").Cells(2, 2).Value
    End If
    If LIST2 = True Then
        strChaine = Sheets("AddressBook").Cells(3, 2).Value
    End If
    
    Doc.CopyTo = strChaine
    Doc.body = "Bonjour," & vbLf & vbLf & "ci-joint les rapports OROP de la nuit du " & VBA.Date - 1 & " au " & VBA.Date & vbLf & vbLf & "Cordialement," & vbLf & "Team GPMX"
    
    'Joindre le fichier OROP en PJ
    'On le sauvegarde pour s'assurer d'avoir la derniere version.
    ActiveWorkbook.Save
    ActiveSheet.Copy 
    Attachment = ActiveWorkbook.Path + "\" + ActiveWorkbook.Name ==> La ligne qui ne marche apparemment plus
    Set EmbedObj = AttachME.EmbedObject(1454, "", Attachment, "BODY")
    
    'Affichage du mail dans Lotus Notes
    Set EditDoc = Workspace.EDITDOCUMENT(True, Doc)
    
    Set session = Nothing
    Set Dir = Nothing
    Set Doc = Nothing
    Set Workspace = Nothing
    Set EditDoc = Nothing
    
    Exit Sub

Qui pourrait m'aider ?
Apres quelques investigations de mon coté le chemin fourni pour la variable attachment n'est pas valide...
ActiveWorkbook.Path n'est pas renseigné. Il semble donc normal que Lotus notes n'arrive pas à trouver le chemin fabriquer avec Attachment = ActiveWorkbook.Path + "\" + ActiveWorkbook.Name.
Mais je ne vois pas du tout comment proceder autrement :/

Merci d'avance.
 
Dernière édition:
Trier par date Trier par votes
N

N3oTraX

XLDnaute Nouveau
[Résolu] Envoi de la feuille active via lotus notes

En suivant un peu ton idée... Voilà à quoi je suis arrivé...
C'est fonctionnel, ça n'envoie que la feuille active d'un fichier enregistré au préalable sur le disque dur.
Ce dernier sera détruit à la fin de la procédure.

Je tiens à ajouté que l'envoi via Lotus Notes 8 à particulièrement été soigné, et peux (au choix dans le code) envoyer avec la boite mail perso de l'utilisateur (session active lotus) ou bien envoyer le courrier via une autre boite mail (en reseignant un application et un serveur différent dans le code).

Code: 
Public Sub Send_LotusMail(LIST1 As Boolean, LIST2 As Boolean)

    Dim session As Object       'Session Notes
    Dim Dir As Object
    Dim Doc As Object
    Dim AttachME As Object      'Objet richtext
    Dim EmbedObj As Object      'Objet embed du richtext
    Dim Footpage As Object      'pied de page
    Dim Workspace As Object
    Dim EditDoc As Object
    Dim cc As String
    Dim strChaine As String
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim Temp As String
    Dim Fichier As String

    'Création de la session Notes
    Set Workspace = CreateObject("Notes.NotesUIWorkspace")
    Set session = CreateObject("notes.NOTESSESSION")
    Set Dir = session.GetDatabase("XXXXXX/XXXXXXXXX", "xxxx/xxxxx/XXXXXXX.nsf")
    
    If Not Dir.IsOpen Then Dir.OPENMAIL
    
    'Creation d'un document
    Set Doc = Dir.CreateDocument
    Set AttachME = Doc.CREATERICHTEXTITEM("BODY")
    
    Doc.form = "Memo"
    Doc.Subject = "Rapport OROP de la nuit du " & VBA.Date - 1 & " au " & VBA.Date
    Doc.SendTo = ""
    
    If Not LIST1 And Not LIST2 Then
        MsgBox "Merci de vérifier que vous êtes bien sur le rapport OROP original"
        Exit Sub
    Else
        'Initialisation des destinataire en copy par défaut
        If LIST1 = True Then
            strChaine = Sheets("AddressBook").Cells(2, 2).Value
        End If
        If LIST2 = True Then
            strChaine = Sheets("AddressBook").Cells(3, 2).Value
        End If
    End If
    
    Doc.BlindCopyTo = strChaine
    Doc.body = "Bonjour," & vbLf & vbLf & "ci-joint les rapports OROP de la nuit du " & VBA.Date - 1 & " au " & VBA.Date & vbLf & vbLf & "Cordialement," & vbLf & "Team GPMX"
    
    'Nouvel envoi compatible excel 2007
    Set Sourcewb = ActiveWorkbook
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook
    
    Temp = ThisWorkbook.Path & Application.PathSeparator & "Rapport_OROP.xlsx"
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
    Destwb.SaveAs Temp
    Fichier = Destwb.Path & Application.PathSeparator & Destwb.Name
    Destwb.Close
    Application.DisplayAlerts = True

    'Fin test nouvel envoi
    
    Set EmbedObj = AttachME.EmbedObject(1454, "", Fichier, "BODY")
    
    Application.ScreenUpdating = True
    Kill Fichier
    
    'Affichage du mail dans Lotus Notes
    Set EditDoc = Workspace.EDITDOCUMENT(True, Doc)
    
    Set session = Nothing
    Set Dir = Nothing
    Set Doc = Nothing
    Set Workspace = Nothing
    Set EditDoc = Nothing
    
End Sub
 
Vote positif 0 Vote négatif
N

N3oTraX

XLDnaute Nouveau
Re : [Résolu] Envoi de la feuille active via lotus notes

Subsiste quand même un bug... Le format ".xls" est à chaque fois vérolé, et excel ne récupère pas mes données correctement alors que j'avais réussi à le faire fonctionner...

Quelqu'un aurait une idée pour enregistrer en .xls depuis excel 2007 sans perte de données ?
 
Vote positif 0 Vote négatif
N

N3oTraX

XLDnaute Nouveau
Re : [Résolu] Envoi de la feuille active via lotus notes

Solution trouvée, même si au final la différence m'échappe !

Code: 
Public Sub Send_OROP(LIST1 As Boolean, LIST2 As Boolean)

    Dim session As Object       'Session Notes
    Dim Dir As Object
    Dim doc As Object
    Dim EmbedObj As Object      'Objet embed du richtext
    Dim Workspace As Object
    Dim EditDoc As Object
    Dim cc As String
    Dim strChaine As String
    Dim Destwb As Workbook
    Dim Temp As String
    Dim Fichier As String
    Dim AttachME As Object
    Dim FileExtStr As String
    Dim FileFormatNum As Long

    'Création de la session Notes
    Set Workspace = CreateObject("Notes.NotesUIWorkspace")
    Set session = CreateObject("notes.NOTESSESSION")
    Set Dir = session.getdatabase("XXXXXXX/XXXXX/XXXX", "xxxxx/xxxxx/XXXXXXX.nsf")
    
    If Not Dir.IsOpen Then Dir.OpenMail
    
    'Creation d'un document
    Set doc = Dir.CreateDocument
    Set AttachME = doc.CREATERICHTEXTITEM("BODY")
    
    doc.Form = "Memo"
    
    MsgBox Hour(Now())
    
    'Si nous somme en semaine => donc jour actuel différent de samedi ou dimanche (= 6 & 1 avec la fonction weekday())
    If Weekday(Now()) <> 2 And Weekday(Now()) <> 6 Then
        'Alors le rapport orop envoyé est celui de la nuit
        doc.Subject = "Rapport OROP de la nuit du " & VBA.Date - 1 & " au " & VBA.Date
        doc.body = "Bonjour," & vbLf & vbLf & "ci-joint les rapports OROP de la nuit du " & Date - 1 & " au " & Date & vbLf & vbLf & "Cordialement," & vbLf & "Team GPMX"
    Else
        'Sinon on teste l'heure d'envoi (entre 17h et 20h)
        If Hour(Now()) > 17 & Hour(Now()) < 20 Then
            'Alors le rapport orop envoyé est celui de la journée en week-end
            doc.Subject = "Rapport OROP du " & VBA.Date
            doc.body = "Bonjour," & vbLf & vbLf & "ci-joint les rapports OROP du " & Date & vbLf & vbLf & "Cordialement," & vbLf & "Team GPMX"
        End If
    End If
    
    doc.SendTo = ""
    
    If Not LIST1 And Not LIST2 Then
        MsgBox "Merci de vous assurer d'exécuter la macro depuis le rapport OROP d'origine."
        Exit Sub
    Else
        'Initialisation des destinataire en copy par défaut
        If LIST1 = True Then
            strChaine = Sheets("AddressBook").Cells(2, 2).Value
        End If
        If LIST2 = True Then
            strChaine = Sheets("AddressBook").Cells(3, 2).Value
        End If
    End If
    
    doc.BlindCopyTo = strChaine
    
    'Nouvel envoi compatible excel 2007
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook
    
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        End If
    End With
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
    Temp = ThisWorkbook.Path & Application.PathSeparator & "Rapport_OROP_du_" & Format(Now, "dd-mm-yyyy")
    
    With Destwb
        .SaveAs Temp & FileExtStr, FileFormat:=56
    End With
    
    Fichier = Destwb.Path & Application.PathSeparator & Destwb.Name
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
    Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Fichier, "BODY")
    
    Application.ScreenUpdating = True
    'Kill Fichier
    
    'Affichage du mail dans Lotus Notes
    Set EditDoc = Workspace.EDITDOCUMENT(True, doc)
    
    'Destruction
    Destwb.Close
    Kill Fichier
    Set session = Nothing
    Set Dir = Nothing
    Set doc = Nothing
    Set Workspace = Nothing
    Set EditDoc = Nothing
    
End Sub

En espérant que cela fasse le bonheur de certains... En tout cas moi j'en ai bavé pour une de mes premières "vrai" macro :)
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

patricktoulon
  • Résolu(e)
XL 2013 petit problème de caractère a la création du xml
2
Réponses
23
Affichages
779
patricktoulon
patricktoulon
S
  • Question
XL 2013 Convertir classeur en PDF, crypter avec mot de passe et envoyer via Outlook
Réponses
2
Affichages
1 K
Saliou MBALO
S
H
  • Question
Microsoft 365 Incrémenter une variable en fonction de la ligne où se trouve le bouton de commande
Réponses
1
Affichages
2 K
Staple1600
Staple1600
bellenm
  • Question
Gmail via CDO, attacher un fichier PDF, des adresses, un objet et un corps bien définit, code de Roland_M.
2 3
Réponses
43
Affichages
5 K
Roland_M
Roland_M
A
  • Question
XL 2013 ficher excel fermé par lotus notes
Réponses
0
Affichages
754
Arctica
A
X
  • Question
XL 2010 Macro d'envoi de mail pour Lotus Notes - Pb à partir de 7 destinataires
Réponses
2
Affichages
802
Xavier CG
X
chris6999
  • Question
XL 2010 VBA Envoi impression PDF LOTUS Notes 8.5
Réponses
0
Affichages
946
chris6999
chris6999
E
  • Question
VBA Mail de relance via Lotus Notes
Réponses
10
Affichages
2 K
entoanne
E
A
  • Question
VBA Lotus Notes Export d'email et Format du texte lors de la generation d'email
Réponses
2
Affichages
2 K
Bougla972
Bougla972
G
  • Question
[Résolu] Envoi d'un pdf via la messagerie par default
Réponses
10
Affichages
1 K
Gilles52300
G

Membres actuellement en ligne

Aucun membre en ligne actuellement.
1 membres et 37 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 294
Messages
2 086 895
Membres
103 404
dernier inscrit
sultan87