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 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171
|
Option Explicit
Const EMBED_ATTACHMENT As Long = 1454
Const stPath As String = "c:"
Sub Send_Active_Sheet2()
Dim MaDate As String
Dim stFileName As String
Dim vaRecipients As Variant
Dim vaCopyTo As Variant
Dim noSession As Object
Dim noDatabase As Object
Dim noDocument As Object
Dim noEmbedObject As Object
Dim noAttachment As Object
Dim stAttachment As String
Dim vaMsg As Variant
Dim StrSignature As Variant
Dim stSubject As String
stSubject = "Daily event report PB PARIS" & "" & Date$
MaDate = Date
vaMsg = "Bonjour, " & vbCrLf & vbCrLf & vbCrLf & vbCrLf & _
"Veuillez trouver en pièce jointe le fichier des Pcodes sales PB PARIS du" & "" & MaDate & ":" & _
vbCrLf & vbCrLf & vbCrLf & vbCrLf & "Regards " & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & _
"toto" & vbCrLf & _
"+" & "xx" & "(" & "x" & ")" & "xxxxx" & vbCrLf & vbCrLf & _
"fqsfqgqfqf" & vbCrLf & _
"gegzsegzeg" & "" & "|" & "" & "xxxx" & vbCrLf & _
"xxx" & "," & "" & "xxxxxxx" & vbCrLf & _
"75008 Paris" & "" & "-" & "" & "France"
'Copy the active sheet to a new temporarily workbook.
With ActiveSheet
.Copy
stFileName = "Daily event report PB PARIS" & Date$
End With
stAttachment = stPath & "\" & stFileName & ".xls"
'Save and close the temporarily workbook.
With ActiveWorkbook
.SaveAs stAttachment
.Close
End With
'Create the list of recipients.
vaRecipients = "toto@roro.fr"
'vaCopyTo = ""
'Instantiate the Lotus Notes COM's Objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
'If Lotus Notes is not open then open the mail-part of it.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
'Create the e-mail and the attachment.
Set noDocument = noDatabase.CreateDocument
Set noAttachment = noDocument.CreateRichTextItem("stAttachment")
Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
'Add values to the created e-mail main properties.
With noDocument
.Form = "Memo"
.SendTo = vaRecipients
.CopyTo = ""
.Subject = stSubject
.Body = vaMsg
.SaveMessageOnSend = True
.PostedDate = Now()
'.Send 0, vaRecipients
If MsgBox("Vérifier ?", vbYesNo) = vbYes Then
'Affichage du mail dans Lotus Notes
Dim workspace
Set workspace = CreateObject("Notes.NotesUIWorkspace")
Call workspace.EditDocument(True, noDocument).FieldSetText("Body", vaMsg)
MsgBox "please look your lotus windows for checking", vbInformation
Else
.Send 0, vaRecipients
MsgBox "The e-mail has successfully been created and distributed", vbInformation
End If
End With
'Delete the temporarily workbook.
Kill stAttachment
'Release objects from memory.
Set noEmbedObject = Nothing
Set noAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing
End Sub |
Partager