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
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
| Private Sub WorkBook_Open()
' StockCrelogRCC Macro
Workbooks.Open Filename:= _
"G:\CONTRATS1.xls"
Range("A1:K20000").Select
Selection.Copy
Windows("CONTRATS-MOD.xls").Activate
Sheets("RCC").Select
Range("A1:K20000").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' RCT Macro
Workbooks.Open Filename:= _
"G:\CONTRATS2.xls"
Range("A1:K20000").Select
Selection.Copy
Windows("CONTRATS-MOD.xls").Activate
Sheets("RCT").Select
Range("A1:K20000").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks.Open Filename:= _
"G:\CONTRATS1.xls"
'Windows("CONTRATS1.xls").Activate
Range("A1").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
Workbooks.Open Filename:= _
"G:\CONTRATS2.xls"
'Windows("CONTRATS2.xls").Activate
Range("A1").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
'Workbooks.Open Filename:= _
' "G:\CONTRATS-MOD.xls"
Windows("CONTRATS-MOD.xls").Activate
Sheets("RCC").Select
Range("A1").Select
Sheets("RCT").Select
Range("A1").Select
ActiveWorkbook.Save
'Sauvegarde du fichier
Application.DisplayAlerts = False
NomFichier = "CONTRATS-" & Format(Now, "dd-mm-yyyy"".xls")
'NomFichier2 = "CONTRATS.xls"
ChDir "G:\"
ActiveWorkbook.SaveAs Filename:=NomFichier, CreateBackup:=False
'Sub EnvoiLotus()
Workbooks.Open Filename:= _
"G:\CONTRATS-*.xls"
'Set up the objects required for Automation into lotus notes
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)
Set Session = CreateObject("Notes.NotesSession")
'Get the sessions username and then calculate the mail file name
'You may or may not need this as for MailDBname with some systems you
'can pass an empty string
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"
'Pour ouvrir un modèle
MailStationeryName = "Crélog lundi*: Contrats" 'MailStationeryName = "Nom du modèle"
MailDoc.sendto = Split(Worksheets("Destinataires").Cells(2, 2).Value, ",")
MailDoc.CopyTo = Split(Worksheets("Destinataires").Cells(4, 2).Value, ",")
MailDoc.BlindCopyTo = ""
MailDoc.Subject = "Crélog lundi*: Contrats"
Set objNotesField = MailDoc.CREATERICHTEXTITEM("Body")
With objNotesField
.AppendText "Bonjour,"
.AddNewLine 2
.AppendText "Voici le fichier hebdo Contrats" 'tu peux ajouter des lignes
.AddNewLine 2
.AppendText "Cordialement"
.AddNewLine 4
.AppendText "L'équipe"
.AddNewLine 7
.AppendText "Envoi automatique"
.AddNewLine 3
End With
MailDoc.SAVEMESSAGEONSEND = SaveIt
'Set up the embedded object and attachment and attach it
Attachment1 = "G:\CONTRATS-*.xls"
'Attachment2 = ""
'Attachment3 = ""
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment1")
Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment1, "Attachment1")
MailDoc.CREATERICHTEXTITEM (Attachment1)
'Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment2")
'Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment2, "Attachment2")
'MailDoc.CREATERICHTEXTITEM (Attachment2)
'Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment3")
'Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment3, "Attachment3")
'MailDoc.CREATERICHTEXTITEM (Attachment3)
'Send the document
MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder
MailDoc.SEND 0, Recipient
'Clean Up
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
'ActiveWorkbook.Save
'ActiveWorkbook.Close
End Sub |
