Merhabalar,
Ekli kodda dosya yolu masa üstü olarak çıkıyor. Bunu masaüstü/Puantaj Cetveli olarak nasıl gösterebiliriz?
Ekli kodda dosya yolu masa üstü olarak çıkıyor. Bunu masaüstü/Puantaj Cetveli olarak nasıl gösterebiliriz?
Kod:
Kod:
Sub DOSYA_GONDER()
Dim S1 As Worksheet, S2 As Worksheet
Dim Uygulama As Object, Yeni_Mail As Object, Onay As Byte
Dim Yol As String, Secilen_Dosyalar As Variant, Dosya As Variant
Set S1 = Sheets("ANASAYFA")
Beep
Onay = MsgBox(S1.Range("I15") & " mail adresine göndermek istediğinize emin misiniz?", vbYesNo + vbDefaultButton2)
If Onay = vbNo Then
MsgBox "Mail gönderme işleminiz iptal edilmiştir.", vbExclamation
Exit Sub
End If
Yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator
ChDir Yol
Secilen_Dosyalar = Application.GetOpenFilename(Title:="Lütfen mail olarak göndermek istediğiniz dosyaları seçiniz...", MultiSelect:=True)
If IsArray(Secilen_Dosyalar) = False Then
MsgBox "Dosya seçimi yapmadığınız için işlem iptal edilmiştir.", vbExclamation
Exit Sub
End If
On Error Resume Next
Set Uygulama = GetObject(, "Outlook.Application")
On Error GoTo 0
If Uygulama Is Nothing Then Call Shell("Outlook.exe", vbHide)
Set Uygulama = CreateObject("Outlook.Application")
Set Yeni_Mail = Uygulama.CreateItem(0)
With Yeni_Mail
.SentOnBehalfOfName = S1.Range("I13").Value
.To = S1.Range("I15").Value
.Subject = S1.Range("I9").Value & " (" & S1.Range("G5").Value & " )"
.HtmlBody = "Puantaj Cetveli Ekte Gönderilmiştir.!!!!!!" & vbCr & .HtmlBody
For Each Dosya In Secilen_Dosyalar
.Attachments.Add Dosya
Next
.Save
.Send
End With
MsgBox S1.Range("I15") & " adresine mail gönderilmiştir", vbInformation
Set S1 = Nothing
Set S2 = Nothing
Set Uygulama = Nothing
Set Yeni_Mail = Nothing
End Sub
