Bonjour à tous,
Je dois pouvoir envoyer un mail avec Lotus Notes et 1 fichier excel en pièce jointe sur appuis d'un bouton, mais j'aimerais que cela se fasse sans que je rentre les infos dans Lotus. Tout doit se faire de façon transparente pour l'utilisateur.
J'ai bien sur fais une recherche et j'ai trouvé un code, mais dans celui-ci, on défini le user name mais pas le password, or, dans l'entreprise il faut pour se connecter à Lotus le User Name et le passWord.
Ma question est donc, comment définir le Password dans le code.
Voici le code
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 Procédure globale: Public Sub SendNotesMail(ByVal Subject As String, _ ByVal Attachment As String, ByVal RECIPIENT As String, _ ByVal CC As String, ByVal BCC As String, _ ByVal BodyText As String, ByVal SaveIt As Boolean) Dim oMaildb As Object Dim oMailDoc As Object Dim oAttachME As Object Dim oSession As Object Dim oEmbedObj As Object Dim sUserName As String Dim sMailDbName As String Const STR_ATTACHMENT As String = "Attachment" On Error GoTo L_ErrCannotCreateNotesSession Set oSession = CreateObject("Notes.NotesSession") sUserName = oSession.sUserName sMailDbName = Left$(sUserName, 1) & Right$(sUserName, _ (Len(sUserName) - InStr(1, sUserName, " "))) & ".nsf" DoEvents lblStatus.Caption = "Information about sender..." Call Sleep(1000) Set oMaildb = oSession.GETDATABASE(vbNullString, _ sMailDbName) If oMaildb.IsOpen = True Then Else oMaildb.OPENMAIL End If Set oMailDoc = oMaildb.CREATEDOCUMENT oMailDoc.Form = "Memo" oMailDoc.SENDTO = RECIPIENT If Len(CC) = 0 Then Else oMailDoc.CopyTo = BC End If If Len(BCC) = 0 Then Else oMailDoc.blindCopyTo = BCC End If oMailDoc.Subject = Subject oMailDoc.Body = BodyText oMailDoc.SAVEMESSAGEONSEND = SaveIt DoEvents lblStatus.Caption = "Looking for attached files..." Call Sleep(1000) If Attachment <> vbNullString Then Set oAttachME = oMailDoc.CREATERICHTEXTITEM_ (STR_ATTACHMENT) Set oEmbedObj = oAttachME.EMBEDOBJECT(1454, _ vbNullString, Attachment, STR_ATTACHMENT) oMailDoc.CREATERICHTEXTITEM _ (STR_ATTACHMENT) End If DoEvents oMailDoc.PostedDate = Now() 'To send the message, remove the quotes characters (') near each line ' lblStatus.Caption = "Sending message..." ' Call Sleep(1000) ' ' oMailDoc.SEND 0, RECIPIENT ' lblStatus.Caption = "Message sent" ' MsgBox "Your message has been sent successfully...", 64, "End" L_ExCannotCreateNotesSession: Set oMaildb = Nothing Set oMailDoc = Nothing Set oAttachME = Nothing Set oSession = Nothing Set oEmbedObj = Nothing Exit Sub L_ErrCannotCreateNotesSession: Select Case Err Case 429 MsgBox "Impossible de localiser un Client Notes; " & _ "Votre message n'a pas été envoyé !", 16, _ "Lotus Notes requis" Case Else MsgBox "Un erreur a empêché l'envoi du message." & _ vbCrlf & "Veuillez en référer à votre administrateur " & _ "pour lui soumettre cette erreur..." & vbCrlf & Error ,_ 16, "Error #" & Str(Err) End Select Resume L_ExCannotCreateNotesSession End Sub
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6 Mode d'utilisation: Sub CreateMemoNotes() SendNotesMail Me!txtSubject, Me!txtAttachment, Me!txtTo, _ Me!txtCC, Me!txtCCC, Me!txtMessage, False End Sub
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 Déclaration de l'API (A placer en haut de module) : Private Declare Function GetOpenFileName Lib _ "comdlg32.dll" Alias "GetOpenFileNameA" _ (pOpenfilename As OPENFILENAME) As Long Private Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String nMaxCustFilter As Long nFilterIndex As Long lpstrFile As String nMaxFile As Long lpstrFileTitle As String nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle As String flags As Long nFileOffset As Integer nFileExtension As Integer lpstrDefExt As String lCustData As Long lpfnHook As Long lpTemplateName As String End Type Private Const OFN_READONLY = &H1 Private Const OFN_OVERWRITEPROMPT = &H2 Private Const OFN_HIDEREADONLY = &H4 Private Const OFN_NOCHANGEDIR = &H8 Private Const OFN_SHOWHELP = &H10 Private Const OFN_ENABLEHOOK = &H20 Private Const OFN_ENABLETEMPLATE = &H40 Private Const OFN_ENABLETEMPLATEHANDLE = &H80 Private Const OFN_NOVALIDATE = &H100 Private Const OFN_ALLOWMULTISELECT = &H200 Private Const OFN_EXTENSIONDIFFERENT = &H400 Private Const OFN_PATHMUSTEXIST = &H800 Private Const OFN_FILEMUSTEXIST = &H1000 Private Const OFN_CREATEPROMPT = &H2000 Private Const OFN_SHAREAWARE = &H4000 Private Const OFN_NOREADONLYRETURN = &H8000 Private Const OFN_NOTESTFILECREATE = &H10000 Private Const OFN_NONETWORKBUTTON = &H20000 Private Const OFN_NOLONGNAMES = &H40000 Private Const OFN_EXPLORER = &H80000 Private Const OFN_NODEREFERENCELINKS = &H100000 Private Const OFN_LONGNAMES = &H200000
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 Fonction d'affichage de la boîte de dialogue des fichiers à joindre Public Function fnctGetAttachedFiles(ByVal InitialDir _ As String, ByVal Extensions As String, _ ByVal ApplicationName As String) As String Const MIN_PATH As Integer = 260 Const MAX_PATH As Integer = 8192 Dim oOFN As OPENFILENAME Dim lReturn As Long Dim sFilter As String Dim sAttachmentString As String Dim aApplications() As String Dim aExtensions() As String Dim I As Integer aApplications = Split(ApplicationName, ";") aExtensions = Split(Extensions, ";") For I = LBound(aApplications) To UBound(aApplications) sFilter = sFilter & "Fichiers " & aApplications(I) & _ vbNullChar & aExtensions(I) & vbNullChar Next With oOFN .lStructSize = Len(oOFN) .hwndOwner = Application.hWndAccessApp .lpstrFile = Extensions .lpstrFilter = sFilter .nFilterIndex = 1 .lpstrFile = String(MIN_PATH, 0) .flags = OFN_LONGNAMES Or OFN_HIDEREADONLY _ Or OFN_ALLOWMULTISELECT .nMaxFile = IIf((.flags And OFN_ALLOWMULTISELECT) = _ OFN_ALLOWMULTISELECT, MAX_PATH, MIN_PATH - 1) .lpstrFileTitle = .lpstrFile .nMaxFileTitle = .nMaxFile .lpstrInitialDir = IIf(Len(InitialDir) = 0, _ Left(Application.CurrentProject.Path, 3), InitialDir) .lpstrTitle = "Sélection de fichiers en pièces jointes" End With lReturn = GetOpenFileName(oOFN) sAttachmentString = oOFN.lpstrFile If InStr(1, sAttachmentString, vbNullChar) Then sAttachmentString = Trim(Left(sAttachmentString, _ InStr(1, sAttachmentString, vbNullChar) - 1)) End If fnctGetAttachedFiles = sAttachmentString End FunctionMerci.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13 Code à affecter au bouton Parcourir... Sub ShowFileDialog() Dim sAttachmentString As String sAttachmentString = fnctGetAttachedFiles("D:\Data", _ "*.doc;*.xls;*.mdb;*.txt", "Word;Excel;Access;Notepad") If Len(sAttachmentString) > 0 Then Me!txtAttachment = sAttachmentString Else Me!txtAttachment = vbnulstring End If End Sub
Partager