Excelden Mail Gönderirken Sorun Yaşıyorum

caneryamac

caneryamac

Katılım
17 Eylül 2013
Mesajlar
142
Excel Vers. ve Dili
2013
Altın Üyelik Bitiş Tarihi
25/05/2022
Merhaba,

Elimde bir kod var ve için bir hata var ben bulamıyorum üstadlarım birde siz bakar mısınız nerede takılıyorum ben?

Kod: 
.HTMLBody = "Sayın, " & SG.Range("C1") & "<BR>" & "Muhasebe Servisi Dikkatine!" & "<BR><BR>" & _
                    Sheets("AYARLAR").Range("C2") & " dönemi BA/BS formu rakamları aşağıdadır." & "<BR>" & _
                    SF.Range("B25") & SF.Range("C25") & "<BR>" & SF.Range("B26") & SF.Range("C26") & "<BR><BR>" & _
                    "Gerekli kontrollerin yapılarak rakamlarda mutabık olup / olmadığımıza dair " & _
                    "bilginin fax, telefon veya e-mail ile verilmesini rica ederiz." & "<BR><BR>" & _
                    "Mutabık olmadığımız takdirde hesap ekstrenizi tarafımıza fax veya e-mail ile gönderiniz." & "<BR>" & _
                    "İyi çalışmalar. " & "<BR><BR>" & _
                    "Not : Mutabakat mektubu mail ekindedir." & "<BR><BR>" & _
                    "Caner YAMAÇ " & "<BR>" & _
                    "Muhasebe " & "<BR><BR>" & _
                    "XX DIŞ TİCARET VE SANAYİ A.Ş. " & "<BR>" & _
                    "xx Mah. xx Yolu No:xx " & "<BR>" & _
                    "xx Esenyurt - İstanbul - Türkiye " & "<BR>" & _
                    "TEL: xx " & "<BR>" & _
                    "FAX: xx " & "<BR>" & _
                    "WEB: xx.com.tr " & "<BR>" & _
 
A

askm

Destek Ekibi
Destek Ekibi
Katılım
4 Haziran 2005
Mesajlar
2,745
Excel Vers. ve Dili
2010-2016
Kodun tamamını paylaşabilir misiniz."WEB: xx.com.tr " & "<BR>" & _ burdan kodun devam ettiği anlaşılıyor. Bu kısım sadece mailin gövde kısmını içeriyor.Hata olan kısmı anlayabilmemiz için kodu tam eklerseniz bakalım.
 
caneryamac

caneryamac

Katılım
17 Eylül 2013
Mesajlar
142
Excel Vers. ve Dili
2013
Altın Üyelik Bitiş Tarihi
25/05/2022
askm' Alıntı:
Kodun tamamını paylaşabilir misiniz."WEB: xx.com.tr " & "<BR>" & _ burdan kodun devam ettiği anlaşılıyor. Bu kısım sadece mailin gövde kısmını içeriyor.Hata olan kısmı anlayabilmemiz için kodu tam eklerseniz bakalım.
Genişletmek için tıkla ...
Kod: 
Sub KOD_MAİL_GÖNDER()
    
    msj = MsgBox(" Seçili alanama mail göndermek istiyor musunuz ? ", vbYesNo, "Caner YAMAÇ")
    If msj = vbNo Then GoTo atla
    
    Dim SG As Worksheet: Set SG = Sheets("GÖNDER")
    Dim SF As Worksheet: Set SF = Sheets("FORM")
    
    SG.Range("A6:A" & Rows.Count).ClearContents
    
    yol = ThisWorkbook.Path & "\"
    
    Dim ilk_sat As Long, son_sat As Long
    
    With Selection
        ilk_sat = .Row
        son_sat = .Rows.Count + ilk_sat - 1
    End With
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    If ilk_sat >= 6 And Selection.Column = 3 Then
        
        For sat = ilk_sat To son_sat
            SG.Cells(sat, "A") = "X"
            
            If Range("kontrol") = "" Then
                MsgBox "Firma seçimi yapmalısınız.", vbCritical, "Caner YAMAÇ"
                GoTo atla
            Else
                
                kime = SG.Range("I1").Value
                müşteri = SG.Range("C1").Value
                Range("say") = Range("say") + 1
                
                SF.Select
                On Error Resume Next
                SF.ExportAsFixedFormat Type:=xlTypePDF, _
                Filename:=yol & Range("isim") & ".pdf", _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
                On Error GoTo 0
                SG.Select
                
                Dim objOutlook As Object
                Dim objMail As Object
                Set objOutlook = CreateObject("Outlook.Application")
                Set objMail = objOutlook.CreateItem(0)
                
                With objMail
                    .To = kime
                    .Subject = Range("konu").Value
                    
                    .HTMLBody = "Sayın, " & SG.Range("C1") & "<BR>" & "Muhasebe Servisi Dikkatine!" & "<BR><BR>" & _
                    Sheets("AYARLAR").Range("C2") & " dönemi BA/BS formu rakamları aşağıdadır." & "<BR>" & _
                    SF.Range("B25") & SF.Range("C25") & "<BR>" & SF.Range("B26") & SF.Range("C26") & "<BR><BR>" & _
                    "Gerekli kontrollerin yapılarak rakamlarda mutabık olup / olmadığımıza dair " & _
                    "bilginin fax, telefon veya e-mail ile verilmesini rica ederiz." & "<BR><BR>" & _
                    "Mutabık olmadığımız takdirde hesap ekstrenizi tarafımıza fax veya e-mail ile gönderiniz." & "<BR>" & _
                    "İyi çalışmalar. " & "<BR><BR>" & _
                    "Not : Mutabakat mektubu mail ekindedir." & "<BR><BR>" & _
                    "Caner YAMAÇ " & "<BR>" & _
                    "Muhasebe " & "<BR><BR>" & _
                    "xxx DIŞ TİCARET VE SANAYİ A.Ş. " & "<BR>" & _
                    "Axxx Mah. xxx Yolu No:xxx " & "<BR>" & _
                    "34522 Esenyurt - İstanbul - Türkiye " & "<BR>" & _
                    "TEL:+90 212 xxx-153 " & "<BR>" & _
                    "FAX:+90 212 xxx " & "<BR>" & _
                    "WEB:www.xxx.com.tr " & "<BR>" & _


                    .Attachments.Add yol & Range("isim") & ".pdf"
                    .Save
                    '.Display
                    .Send
                End With
                Set objMail = Nothing
                Set objOutlook = Nothing
                Kill yol & Range("isim") & ".pdf"
            End If
            SG.Cells(sat, "A") = ""
        Next sat
    Else
        MsgBox "Hatalı Seçim Aralığındasınız." & Chr(10) & _
        "C sütununda Seçim Yapın...", vbCritical
        GoTo atla
    End If
    
    SG.Select
    SG.Cells(son_sat + 1, "C").Select
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    MsgBox " En Son " & müşteri & " firmasına " & Chr(10) & "Mail gönderildi.", vbInformation, "Caner YAMAÇ"
    
    
    
    Exit Sub
atla:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
End Sub

Ekledim , ilginiz için teşekkürler ,
 
A

askm

Destek Ekibi
Destek Ekibi
Katılım
4 Haziran 2005
Mesajlar
2,745
Excel Vers. ve Dili
2010-2016
"WEB: xx.com.tr " & "<BR>" & _ kısmındaki & _ kısmını silip dener misiniz.
 
caneryamac

caneryamac

Katılım
17 Eylül 2013
Mesajlar
142
Excel Vers. ve Dili
2013
Altın Üyelik Bitiş Tarihi
25/05/2022
Üstadlarım aşağıda yer alan kodda " .Attachments.Add yol & Range("isim") & ".pdf" " hatası alıyorum çözemedim.Yardım edermisiniz?


Sub KOD_MAİL_GÖNDER()

msj = MsgBox(" Seçili alanama mail göndermek istiyor musunuz ? ", vbYesNo, "Caner YAMAÇ")
If msj = vbNo Then GoTo atla

Dim SG As Worksheet: Set SG = Sheets("GÖNDER")
Dim SF As Worksheet: Set SF = Sheets("FORM")

SG.Range("A6:A" & Rows.Count).ClearContents

yol = ThisWorkbook.Path & "\"

Dim ilk_sat As Long, son_sat As Long

With Selection
ilk_sat = .Row
son_sat = .Rows.Count + ilk_sat - 1
End With

Application.ScreenUpdating = False
Application.EnableEvents = False

If ilk_sat >= 6 And Selection.Column = 3 Then

For sat = ilk_sat To son_sat
SG.Cells(sat, "A") = "X"

If Range("kontrol") = "" Then
MsgBox "Firma seçimi yapmalısınız.", vbCritical, "Caner YAMAÇ"
GoTo atla
Else

kime = SG.Range("I1").Value
müşteri = SG.Range("C1").Value
Range("say") = Range("say") + 1

SF.Select
On Error Resume Next
SF.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=yol & Range("isim") & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
On Error GoTo 0
SG.Select

Dim objOutlook As Object
Dim objMail As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)

With objMail
.To = kime
.Subject = Range("konu").Value

.HTMLBody = "Sayın, " & SG.Range("C1") & "<BR>" & "Muhasebe Servisi Dikkatine..!" & "<BR><BR>" & _
Sheets("AYARLAR").Range("C2") & " dönem sonu rakamları ACİL göndermeniz gerekmektedir." & "<BR>" & _
"Mutabakat yapılamayan yada ekstre yollamayan firmalara ödeme yapılmayacaktır. " & "<BR><BR>" & _
"İyi çalışmalar. " & "<BR><BR>" & _
"Not : Son ekstre gönderim tarihi 17.07.2018 ve ödeme tarihi 20.07.2018'dir." & "<BR><BR>" & _
"BUNDAN SONRA MAİL ATILMAYACAK OLUP, ÖDEME PLANINA EN GEÇ 1 HAFTA KALA EKSTRE GÖNDERMENİZ GEREKMEKTEDİR." & "<BR><BR>" & _
"Caner YAMAÇ " & "<BR>" & _
"Muhasebe " & "<BR><BR>" & _
"PUKKA GİYİM SANAYİ VE TİCARET LTD.ŞTİ. " & "<BR>" & _
"Beylikdüzü OSB Mah. Bakırcılar Pirincçiler San. Sit." & "<BR>" & _
"Kurdoğlu Cad. No:32 Kat:3/4 34520" & "<BR>" & _
"TEL:+90 212 876 57 69 " & "<BR>" & _
"FAX:+90 212 875 10 39" & "<BR>" & _
"'http://www.pukkagiyim.com/ " & "<BR>"


.Attachments.Add yol & Range("isim") & ".pdf"


.Save
'.Display
.Send
End With
Set objMail = Nothing
Set objOutlook = Nothing
Kill yol & Range("isim") & ".pdf"
End If
SG.Cells(sat, "A") = ""
Next sat
Else
MsgBox "Hatalı Seçim Aralığındasınız." & Chr(10) & _
"C sütununda Seçim Yapın...", vbCritical
GoTo atla
End If

SG.Select
SG.Cells(son_sat + 1, "C").Select

Application.ScreenUpdating = True
Application.EnableEvents = True

MsgBox " En Son " & müşteri & " firmasına " & Chr(10) & "Mail gönderildi.", vbInformation, "Caner YAMAÇ"



Exit Sub
atla:
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub
 
caneryamac

caneryamac

Katılım
17 Eylül 2013
Mesajlar
142
Excel Vers. ve Dili
2013
Altın Üyelik Bitiş Tarihi
25/05/2022
PDF kaydet eklentim olmadığı için bu hatayı aldım. Düzelttim teşekkür ederim. sorun kalmadı.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst