Yukardaki koda göre ayarladım. imza Sayfasi adında sayfa ekledim oraya imzanızı resim olarak ekleyip ismini resimdeki gibi değiştirin.
Olmayan şey ise outlooka gidince orda beklemesi onun sebebini bende bilmiyorum.
Feraz Hocam peki sizde outlooka gidince outlooku açıp gönder al yaptığınızda gidiyor mu.?
Feraz Hocam normalde olması gereken Sayın İbaresinden sonra "C" hücresindeki Firma Ünvanının gelmesi fakat resimde gördüğünüz gibi "G" hücresindeki mail adres bilgisi geliyor. Fakat çalışan aşağıdaki koda göre orada "B" hücresindeki Firma adı bilgisi olması gerekiyor.
Dün akşamda bu yüzden sapıttım koda bakıyorum sayın ifadesinden sonra orada Firma adının olması lazım ama G hücresindeki mail adres bilgisi var.
Ama orda olması istenen "C" hücresindeki Firma Ünvanı bilgisi. Oraya "B" yerine "C" yazdığımda da haliyle sapıtıyor program. Burdaki sorunu aşamadım allahını seven yardıma gelsin
Kod:
For i = Val(baslasatir.Row) To Val(bitissatir.Row)
If syfEmail.Range("B" & i).Value <> "" Then
On Error Resume Next
Set oLookApp = GetObject(, "Outlook.Application")
If Err.Number = 429 Then
Err.Clear
Set oLookApp = New Outlook.Application
End If
On Error GoTo 0
Set oLookItm = oLookApp.CreateItem(olMailItem)
With oLookItm
.To = CStr(syfEmail.Range("C" & i).Value)
.Subject = "2021 WINPERAX Teknik Ürün Kataloğu"
.Attachments.Add ek
.Body = "Sayın " & CStr(syfEmail.Range("B" & i).Value) & "," _
& vbNewLine & vbNewLine & "Ekte 2021 WINPERAX Teknik Ürün Katalo?u dikkatinize sunulmu?tur." _
& vbNewLine & vbNewLine & "Ylginizi çekece?ini ümit ederek," _
& vbNewLine & vbNewLine & "firmalarymyz arasynda kalycy bir i?birli?i olu?masy temennisi ile sa?lykly günler dileriz."
.Display
Set oWdEditor = .GetInspector.WordEditor
Set oWdRng = oWdEditor.Application.ActiveDocument.Content
oWdRng.InsertAfter " " & vbNewLine & vbNewLine & vbNewLine
oWdRng.Collapse Direction:=wdCollapseEnd
oWdRng.Paste
.Send
say = say + 1
DoEvents
usrKalanMail.lblKalan.Caption = kacsatir - say
Application.Wait (Now + TimeValue(zaman))
Set oLookItm = Nothing
Set oLookApp = Nothing
End With
End If
Next
' Application.Wait (Now + TimeValue("0:0:1"))
Unload usrKalanMail
var:
syfEmail.Unprotect "171717"
syfEmail.Cells.Clear
syfEmail.Protect "171717"
MsgBox "Gönderildi..", vbInformation, "Bilgi"
Application.CutCopyMode = False
Set syfAna = Nothing: Set syfEmail = Nothing
Exit Sub
son:
MsgBox "Gönderilecek adres bulunamadi...", vbCritical, "Hata"
Application.CutCopyMode = False
End Sub
Dur abey bugün senin işi çözeceğiz c ve b sütun olayını