Merhaba Sayın @
oğuz Türkyılmaz
Sevgili @
feraz Hocamın bahsettiği ve sizin hata aldığınız ayar Outlook'ta oluşturmuş olduğunuz imzayı değil resmi e-imza sertifikalarını aktive etmek için kullanılır. Sisteminizde kayıtlı bir e-imza sertifikası göstermediğinizden hata mesajı alıyorsunuz. Sizin yapmak istediğiniz anladığım kadarı ile Outlook için oluşturduğunuz imzanızı kullanmak.
CommandButton2 tıklanması olayına yazdığınız kodu aşağıdaki ile değiştirip dener misiniz? Referanslardan da Microsoft Outlook xx.x Object Library'yi ekleyin. Outlook'u object olarak değil application olarak tanımlayın. Mesajınızı da body olarak değil HTMLbody olarak tanımlayın.
Private Sub CommandButton2_Click()
Dim objOutlook As Outlook.Application
Dim objMail As Outlook.MailItem
Dim maill As String
Dim i As Long, ek
Dim syfAna As Worksheet
Dim basla, bitis
Set syfAna = ThisWorkbook.Sheets("Ana_Sayfa")
ChDir (ThisWorkbook.Path & Application.PathSeparator)
ek = Application.GetOpenFilename("Files (*.**)," & "*.**", 1, "Select File", "Open", False)
If ek = vbNullString Then Exit Sub
If ek = False Then Exit Sub
basla = InputBox("Başlangıç ID satır numarasını Giriniz.")
If basla < 2 Then Exit Sub
If basla = "" Then Exit Sub
bitis = InputBox("Bitis ID Satır numarasını Giriniz.")
If bitis = "" Then Exit Sub
If IsNumeric(basla) = False Then Exit Sub
If IsNumeric(bitis) = False Then Exit Sub
If basla > bitis Then Exit Sub
If WorksheetFunction.CountA(syfAna.Range("G2:G" & Rows.Count)) = 0 Then GoTo son
For i = Val(basla) To Val(bitis)
var2:
If Trim(syfAna.Range("G" & i).Value) <> "" Then maill = maill & syfAna.Range("G" & i).Value & ";"
If i Mod 50 = 0 Then Exit For
Next
i = i + 1
maill = Left(maill, Len(maill) - 1)
Set objOutlook = New Outlook.Application
Set objMail = objOutlook.CreateItem(objMailItem)
With objMail
.To = maill
.Subject = "2021 WINPERAX Teknik Ürün Kataloğu"
.Display
.Attachments.Add ek
.Importance = 2
.Save
.HTMLbody = "Sayın yetkili, Ekte 2021 WINPERAX Teknik Ürün Kataloğu bulunmaktadır. İyi Çalışmalar Dileriz.Saygılarımızla," & .HTMLbody
'.Send
Application.Wait (Now + TimeValue("0:00:59"))
End With
maill = vbNullString
If i >= bitis Then GoTo var
GoTo var2
var:
MsgBox "Gönderildi..", vbInformation, "Bilgi"
Set objMail = Nothing
Set objOutlook = Nothing
Set syfAna = Nothing
Exit Sub
son:
MsgBox "Hata oldu", vbCritical, "Hata"
GoTo var
End Sub
Microsoft kodlarınıza yönelik bir dönüş yapmaz sizi genelde knowledge base'e yönlendirir. Aradığınız cevap olacağına pek güvenemiyorum. Cevap umarım işinize yarar, iyi çalışmalar.