DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub ExcelToPDFandAttachToOutlookDrafts()
' PDF dosyasını oluşturmak için sayfanın adını belirtin
Dim sheetName As String
sheetName = "1001" ' Sayfa adını kendi sayfanıza göre değiştirin
' PDF dosyasının kaydedileceği yol ve dosya adını belirtin
Dim pdfPath As String
pdfPath = "C:\dosya yolunu yaz \example.pdf" ' Kayıt yolunu kendi sistem yolunuza göre değiştirin
' E-posta konusunu ve içeriğini belirtin
Dim emailSubject As String
emailSubject = "Konu: Excel Sayfa PDF'e Dönüştürüldü"
Dim emailBody As String
emailBody = "Merhaba, Ekte Excel sayfasının PDF formatına dönüştürülmüş hali bulunmaktadır."
' Sayfa PDF'e dönüştürme işlemi
On Error Resume Next
Sheets(sheetName).ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfPath
On Error GoTo 0
If Err.Number <> 0 Then
MsgBox "PDF oluşturma hatası: " & Err.Description, vbExclamation
Exit Sub
End If
' Outlook taslağı oluşturma ve PDF ekleyerek kaydetme işlemi
CreateOutlookDraftWithAttachment emailSubject, emailBody, pdfPath
End Sub
Sub CreateOutlookDraftWithAttachment(subject As String, body As String, attachmentPath As String)
Dim outlookApp As Object
Set outlookApp = CreateObject("Outlook.Application")
Dim outlookMail As Object
Set outlookMail = outlookApp.CreateItem(0)
' E-posta bilgilerini ayarla
With outlookMail
.subject = subject
.body = body
.Attachments.Add attachmentPath
' Outlook taslağını belirli bir dizine kaydet
SaveDraftToFolder outlookMail, "C:\Users\XXXXXXXXXXXX\Desktop\Drafts"
End With
' Kullanıcıya e-posta gönderme onayını göster
If MsgBox("E-posta taslağı oluşturuldu. Şimdi e-postayı göndermek ister misiniz?", vbQuestion + vbYesNo, "E-posta Gönder") = vbYes Then
outlookMail.Display
End If
' Nesneleri serbest bırak
Set outlookMail = Nothing
Set outlookApp = Nothing
End Sub
Sub SaveDraftToFolder(mailItem As Object, folderPath As String)
' Belirli bir dizine Outlook taslağını kaydet
Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")
' Dizin yoksa oluştur
If Not fs.FolderExists(folderPath) Then
fs.CreateFolder folderPath
End If
' Taslağı belirli dizine kaydet
mailItem.SaveAs folderPath & "\" & "ExcelToPDFDraft.msg"
' Nesneleri serbest bırak
Set fs = Nothing
End Sub