Discussion :

[letrumeau]

Bonjour,
J'avais trouvé le code suivant qui fonctionnait parfaitement avec LOTUS 8.5.
Depuis je suis passé sous "SEVEN" et LOTUS 9.0.
Le VBA ne fonctionne plus.

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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
Private Sub CommandButton6_Click()
' Bouton MAIL LOTUS
Dim Semaine As String
Dim Annee As Integer
Dim NomDuFichier As String
 
Application.ScreenUpdating = False
'------- compléter les variables nécessaires pour envoi --------------
Semaine = InputBox("Saisir le Numéro de semaine (Exemple: S6)")
If Semaine = "" Then GoTo FinMail ' Sort si aucune valeur ou Annuler
Annee = InputBox("Saisir l'année (Exemple: 2015)")
 
NomDuFichier = Semaine & "_" & Annee & ".xls"
 
    AdresDestinataire$ = "toto@free.fr;tata@free.fr;pepe@free.fr" 'si plusieurs adresses s_parer par le point virgule !
    Sujet$ = "Astreintes Groupe Incendie" ' sujet
    Message$ = "Veuillez trouver ci-joint le fichier relatif à la semaine" & " " & Semaine ' message
    Fichier$ = NomDuFichier   ' "NomDuFichier.xls"
    Chemin$ = "X:\bidon\Sauvegardes\" ' chemin du fichier exp: = ThisWorkbook.Path
    If Chemin$ > "" And Right(Chemin$, 1) <> "\" Then Chemin$ = Chemin$ & "\"
    CheminEtFichier$ = Chemin$ & Fichier$
 
'------ départ envoi messagerie --------
'met en tableau si plusieurs adresses !?
        If InStr(AdresDestinataire$, ";") = 0 Then AdresDestinataire$ = AdresDestinataire$ & ";"
Dim TabloAdresDestin As Variant
TabloAdresDestin = Split(AdresDestinataire$, ";")
 
'------ Préparation session ------
On Error GoTo ErreurNET: Err.Clear
 
Dim oSession As Object     ' CreateObject("Notes.NotesSession")
Dim UserName As String     ' Nom d'utilisateur
Dim DataBase As Object     ' Base des mails
Dim DataBaseName As String ' Nom de la base
Dim Document As Object     ' Mail
Dim AttachME As Object     ' Fich joint en RTF
Dim AttachF1 As Object     '1' pièce attach_e
 
' Création de la session
Set oSession = CreateObject("Notes.NotesSession")
 
' Récupération du nom d'utilisateur
UserName = oSession.UserName
DataBaseName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
 
' Ouvre la base des mails (si fermé, ouvre et demande le password)
Set DataBase = oSession.GetDataBase("", DataBaseName)
        If Not DataBase.IsOpen Then DataBase.OpenMail
 
            ' Boucle envoi au(x) destinataire(s)
            For i = LBound(TabloAdresDestin) To UBound(TabloAdresDestin)
                If Trim(TabloAdresDestin(i)) > "" Then
                AdresDestinataire$ = TabloAdresDestin(i)
 
    ' Crée le document et colle /AdresDestinataire /Sujet /Message
    Set Document = DataBase.CreateDocument
    Document.Form = "Memo"
    Document.Sendto = AdresDestinataire$
    Document.Subject = Sujet$
    Document.Body = Message$
 
    ' Joint le Fichier s'il y a !?
                    If CheminEtFichier$ <> "" Then
                        Set AttachME = Document.CreateRichTextItem("Attachment")
                        Set AttachF1 = AttachME.EmbedObject(1454, "", CheminEtFichier, "Attachment")
                    End If
    ' Envoi le Mail
    Document.SaveMessageOnSend = True ' True = save dans les courriers envoyés
    Document.PostedDate = Now() ' Date du jour
    Document.Send 0, AdresDestinataire$ ' Envoi
 
    PlaySound "D:\Sauvegardes\Mail_Sent.wav", ByVal 0&, SND_FILENAME Or SND_ASYNC
 
    ' Reinit adresse suivante !?
    Set Document = Nothing: Set AttachME = Nothing: Set AttachF1 = Nothing
                End If
            Next
 
GoTo FinMail ' Fin ########################################################
 
ErreurNET:
Msg$ = "Erreur " & Err.Source & "  No " & Err.Number & vbLf & vbLf & Err.Description
T$ = "Envoi Mail: Problème de connexion !?"
MsgBox Msg$, vbCritical, T$, Err.HelpFile, Err.HelpContext
GoTo FinMail
 
FinMail:
' Libère les variables Object
Set oSession = Nothing: Set DataBase = Nothing
Set Document = Nothing: Set AttachME = Nothing: Set AttachF1 = Nothing
On Error GoTo 0: Err.Clear
Application.ScreenUpdating = True
 
End Sub

[joe.levrai]

Bonjour,

un peu vague "le vba ne fonctionne plus"

erreur ? Quel message ? Quelle ligne de code plante ?
Bref, un minimum syndical quoi

[letrumeau]

Bonjour joe.levrai,
C'est un message d'erreur de LOTUS. Je regarde demain au boulot et le dépose dans la foulée.
@+

[joe.levrai]

Quand lotus "va planter", ça va probablement faire planter ta procédure VBA derrière je présume.
vérifie bien si c'est le cas ou non pour récupérer le numéro d'erreur VBA, sa description, et regarder la ligne de code qui sera en jaune (c'est elle qui a planté)

[letrumeau]

Bonjour joe.levrai,
En fait le code fonctionne toujours, le problème venait du chemin temporaire du
classeur à envoyer qui n'était pas bon.
Désolé pour le dérangement.
Bonne journée,
A bientôt.