Discussion :

[mattwarend]

Bonjour à tous,

Merci à tous ceux qui m'ont une nouvelle fois aidé à réaliser ma macro qui permet d'envoyer mon fichier par mail.

Je rencontre cependant un nouveau problème.
Je cherche à l'automatiser avec auto_open ce qui fonctionne, mais mon fichier envoyé contient donc ma macro (avec le auto_open) et la macro se lance donc à l'ouverture de mon fichier envoyé.

Comment procéder pour que cette macro soit désactivée avant envoi, ou supprimée ?

Ci-joint mon code pour info :

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
 
Sub auto_open ()
 
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
 
    Workbooks.OpenText Filename:= _
        "C:\Documents and Settings\moi\Desktop\Usage.txt", Origin:=xlMSDOS, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True
Range("A1").Select
 
    ActiveWorkbook.Save
 
On Error Resume Next
 
 
    Dim Maildb As Object 'The mail database
    Dim UserName As String 'The current users notes name
    Dim MailDbName As String 'THe current users notes mail database name
    Dim MailDoc As Object 'The mail document itself
    Dim AttachME As Object 'The attachment richtextfile object
    Dim Session As Object 'The notes session
    Dim EmbedObj As Object 'The embedded object (Attachment)
    Dim dest As String
    Dim monTab() As String
 
 
    Set Session = CreateObject("Notes.NotesSession")
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
    'Open the mail database in notes
    Set Maildb = Session.GetDatabase("", MailDbName)
     If Maildb.IsOpen = True Then
          'Already open for mail
     Else
 
     Maildb.OPENMAIL
 
     End If
    'Set up the new mail document
    Set MailDoc = Maildb.CreateDocument
    MailDoc.Form = "Memo"
    MailDoc.Subject = "Envoi Automatique Alerte Quota FS01"
    MailDoc.body = "Alerte de Quota sur FS01"
    MailDoc.SAVEMESSAGEONSEND = saveit
 
    Attachment = ThisWorkbook.FullName
    If Attachment <> "" Then
        Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
        Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
        MailDoc.CREATERICHTEXTITEM ("Attachment")
    End If
 
    'Send the document
    dest = Sheets("MACRO").Range("A1") & ", " & Sheets("MACRO").Range("A2")
    monTab = Split(dest, ",")
    MailDoc.Send 0, monTab()
    MailDoc.PostedDate = Now()
 
    'Clean Up
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj = Nothing
 
    Excel.Application.Quit
    Application.DisplayAlerts = False
 
End Sub

[Godzestla]

Re,

je t'ai envoyé une solution par mp il y a 1/2h.

[mattwarend]

Merci ! Je viens de voir ton message.
En fait, je ne sais pas trop où placer le code que tu m'a indiqué :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
Sheets("Parms").Range("A1") = 0
Thisworkbook.saveCopyas Filename:=newname
Sheets("Parms").Range("A1") = 1
if Sheets("Parms").Range("A1") = 1 then
  '... trt email
endif

[Godzestla]

Je n'ai pas l'impression que tu lis ce que je t'envoi......

Essaie encore.

[mattwarend]

Je n'ai pas l'impression que tu lis ce que je t'envoi......

Essaie encore.

Si !!!
J'ai bien ajouté la feuille PARMS comme tu me l'a indiqué.

[Godzestla]

Oui, mais j'avais expliqué plus. Tidju...

Allez en vitesse et sans test possible.

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
Sub auto_open ()
 
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
 
    Workbooks.OpenText Filename:= _
        "C:\Documents and Settings\moi\Desktop\Usage.txt", Origin:=xlMSDOS, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True
Range("A1").Select
    
    ActiveWorkbook.Save
 
On Error Resume Next
 
 
    Dim Maildb As Object 'The mail database
    Dim UserName As String 'The current users notes name
    Dim MailDbName As String 'THe current users notes mail database name
    Dim MailDoc As Object 'The mail document itself
    Dim AttachME As Object 'The attachment richtextfile object
    Dim Session As Object 'The notes session
    Dim EmbedObj As Object 'The embedded object (Attachment)
    Dim dest As String
    Dim monTab() As String
    Dim newname as string
 
     
if Sheets("Parms").Range("A1") = 1 then   
    Set Session = CreateObject("Notes.NotesSession")
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
    'Open the mail database in notes
    Set Maildb = Session.GetDatabase("", MailDbName)
     If Maildb.IsOpen = True Then
          'Already open for mail
     Else
      
     Maildb.OPENMAIL
            
     End If
    'Set up the new mail document
    Set MailDoc = Maildb.CreateDocument
    MailDoc.Form = "Memo"
    MailDoc.Subject = "Envoi Automatique Alerte Quota FS01"
    MailDoc.body = "Alerte de Quota sur FS01"
    MailDoc.SAVEMESSAGEONSEND = saveit
    
   Sheets("Parms").Range("A1") = 0
    newname = "C:\Test.xls"
    Thisworkbook.saveCopyas Filename:=newname
    Sheets("Parms").Range("A1") = 1
    Attachment = newname
    If Attachment <> "" Then
        Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
        Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
        MailDoc.CREATERICHTEXTITEM ("Attachment")
    End If
   
    'Send the document
    dest = Sheets("MACRO").Range("A1") & ", " & Sheets("MACRO").Range("A2")
    monTab = Split(dest, ",")
    MailDoc.Send 0, monTab()
    MailDoc.PostedDate = Now()
    
    'Clean Up
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj = Nothing
    
    Excel.Application.Quit
    Application.DisplayAlerts = False

endif
End Sub