- Katılım
- 3 Ağustos 2006
- Mesajlar
- 38
- Excel Vers. ve Dili
- MS Office 2007 Enterp.
Lotus Notes kullanarak çalışma kitabımı ilgili kişilere mail olarak atıyorum
burada problem yok fakat mail işleminden sonra lotus note programı ekranda açık olarak kalıyor bu da güvenlik açısından problemlere neden oluyor.
Yapmak istediğim mail işleminin tamamlanmasından sonra programın kapatılması bunu nasıl yapabilirim
Kodlar aşağıdadır ve normal olarak çalışıyor
Private Sub CommandButton4_Click()
If CheckBox15 = True Then
mailto = "Levent "
End If
If CheckBox16 = True Then
mailto = "Ferdi "
End If
If CheckBox17 = True Then
mailto = "Haluk"
End If
If CheckBox18 = True Then
mailto = "Faruk"
End If
Dim Maildb As Object
Dim UserName As String
Dim MailDbName As String
Dim MailDoc As Object
Dim attachME As Object
Dim Session As Object
Dim EmbedObj1 As Object
Dim recipient As String
Dim ccRecipient As String
Dim bccRecipient As String
Dim subject As String
Dim bodytext As String
Dim Attachment1 As String
Dim WasOpen As Integer
grftarih = Sheets("veri").Cells(2, 12).Value
' setting up all sending recipients
recipient = mailto
ThisWorkbook.Worksheets("Data").Range("ac1").Value
subject = "2006 Yılı" & " " & grftarih & " " & "Ayı Mixer Bakım Duruşları"
bodytext = "Bu Mail Program Tarafından Otomatik Olarak Gönderilmiştir"
'// Lets check to see if form is filled in Min req =Recipient, Subject, Body Text
If recipient = vbNullString Or subject = vbNullString Or bodytext = vbNullString Then
MsgBox "Recipient, Subject and or Body Text is NOT SET!", vbCritical + vbInformation
Exit Sub
End If
' creating a notes session
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GETDATABASE("", MailDbName)
If Maildb.IsOpen <> True Then
On Error Resume Next
Maildb.OPENMAIL
End If
If Maildb.IsOpen = True Then
WasOpen = 1 'Already open for mail
Else
WasOpen = 0
Maildb.OPENMAIL 'This will prompt you for password
End If
Set MailDoc = Maildb.CreateDocument
MailDoc.form = "Memo"
' loading the lotus notes e-mail with the inputed data
With MailDoc
.sendto = recipient
.copyto = ccRecipient
.blindcopyto = bccRecipient
.subject = subject
.body = bodytext
End With
' saving message
MailDoc.SaveMessageOnSend = True
'Attachment1 = ThisWorkbook.Worksheets("Data").Range("ad1").Value
kayitadi = Sheets("veri").Cells(2, 12).Value
dosyaadi = "C:\My Documents\Presentation\2006\" & kayitadi & ".xls"
Attachment1 = dosyaadi
If Attachment1 <> "" Then
Set attachME = MailDoc.CREATERICHTEXTITEM("Attachment1")
Set EmbedObj1 = attachME.EMBEDOBJECT(1454, "", Attachment1, "Attachment")
MailDoc.CREATERICHTEXTITEM ("Attachment")
End If
' send e-mail !!!!
MailDoc.PostedDate = Now()
' if error in attachment or name of recipients
On Error GoTo errorhandler1
MailDoc.Send 0, recipient
Set Maildb = Nothing
Set MailDoc = Nothing
Set attachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
If WasOpen = 1 Then
Set Session = Nothing
ElseIf WasOpen = 0 Then
Session.Close
Set Session = Nothing
End If
'Unload Me
MsgBox "Mail Başarıyla Gönderildi"
CheckBox15 = False
CheckBox16 = False
CheckBox17 = False
CheckBox18 = False
Exit Sub
' setting up the error message
errorhandler1:
MsgBox "Incorrect name supplied or the attachment has not attached," & _
"or your Lotus Notes has not opened correctly. Recommend you open up Lotus Notes" & _
"to ensure the application runs correctly and that a vaild connection exists"
Set Maildb = Nothing
Set MailDoc = Nothing
Set attachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
End Sub
ilgilenenlere teşekkürler
burada problem yok fakat mail işleminden sonra lotus note programı ekranda açık olarak kalıyor bu da güvenlik açısından problemlere neden oluyor.
Yapmak istediğim mail işleminin tamamlanmasından sonra programın kapatılması bunu nasıl yapabilirim
Kodlar aşağıdadır ve normal olarak çalışıyor
Private Sub CommandButton4_Click()
If CheckBox15 = True Then
mailto = "Levent "
End If
If CheckBox16 = True Then
mailto = "Ferdi "
End If
If CheckBox17 = True Then
mailto = "Haluk"
End If
If CheckBox18 = True Then
mailto = "Faruk"
End If
Dim Maildb As Object
Dim UserName As String
Dim MailDbName As String
Dim MailDoc As Object
Dim attachME As Object
Dim Session As Object
Dim EmbedObj1 As Object
Dim recipient As String
Dim ccRecipient As String
Dim bccRecipient As String
Dim subject As String
Dim bodytext As String
Dim Attachment1 As String
Dim WasOpen As Integer
grftarih = Sheets("veri").Cells(2, 12).Value
' setting up all sending recipients
recipient = mailto
ThisWorkbook.Worksheets("Data").Range("ac1").Value
subject = "2006 Yılı" & " " & grftarih & " " & "Ayı Mixer Bakım Duruşları"
bodytext = "Bu Mail Program Tarafından Otomatik Olarak Gönderilmiştir"
'// Lets check to see if form is filled in Min req =Recipient, Subject, Body Text
If recipient = vbNullString Or subject = vbNullString Or bodytext = vbNullString Then
MsgBox "Recipient, Subject and or Body Text is NOT SET!", vbCritical + vbInformation
Exit Sub
End If
' creating a notes session
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GETDATABASE("", MailDbName)
If Maildb.IsOpen <> True Then
On Error Resume Next
Maildb.OPENMAIL
End If
If Maildb.IsOpen = True Then
WasOpen = 1 'Already open for mail
Else
WasOpen = 0
Maildb.OPENMAIL 'This will prompt you for password
End If
Set MailDoc = Maildb.CreateDocument
MailDoc.form = "Memo"
' loading the lotus notes e-mail with the inputed data
With MailDoc
.sendto = recipient
.copyto = ccRecipient
.blindcopyto = bccRecipient
.subject = subject
.body = bodytext
End With
' saving message
MailDoc.SaveMessageOnSend = True
'Attachment1 = ThisWorkbook.Worksheets("Data").Range("ad1").Value
kayitadi = Sheets("veri").Cells(2, 12).Value
dosyaadi = "C:\My Documents\Presentation\2006\" & kayitadi & ".xls"
Attachment1 = dosyaadi
If Attachment1 <> "" Then
Set attachME = MailDoc.CREATERICHTEXTITEM("Attachment1")
Set EmbedObj1 = attachME.EMBEDOBJECT(1454, "", Attachment1, "Attachment")
MailDoc.CREATERICHTEXTITEM ("Attachment")
End If
' send e-mail !!!!
MailDoc.PostedDate = Now()
' if error in attachment or name of recipients
On Error GoTo errorhandler1
MailDoc.Send 0, recipient
Set Maildb = Nothing
Set MailDoc = Nothing
Set attachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
If WasOpen = 1 Then
Set Session = Nothing
ElseIf WasOpen = 0 Then
Session.Close
Set Session = Nothing
End If
'Unload Me
MsgBox "Mail Başarıyla Gönderildi"
CheckBox15 = False
CheckBox16 = False
CheckBox17 = False
CheckBox18 = False
Exit Sub
' setting up the error message
errorhandler1:
MsgBox "Incorrect name supplied or the attachment has not attached," & _
"or your Lotus Notes has not opened correctly. Recommend you open up Lotus Notes" & _
"to ensure the application runs correctly and that a vaild connection exists"
Set Maildb = Nothing
Set MailDoc = Nothing
Set attachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
End Sub
ilgilenenlere teşekkürler