Çözüldü Klasörden Fotoğraf Çağırma ve Mail Gönderme
Bir tek resim mi yoksa birden fazla mı?
Ayrıca örnek dosya olursa daha hızlı ilerleriz.
Ayrıca örnek dosya olursa daha hızlı ilerleriz.
Ekleyeceğiniz resim sayısı bir den fazlamı ? Yani göndereceğiniz resim sayısı ?
Ayrıca resimler ekli dosya olarak mı gidecek yoksa mail gövdesinde mi olacak.
Ayrıca resimler ekli dosya olarak mı gidecek yoksa mail gövdesinde mi olacak.
ExcelDepo206
Normal Üye
Merhaba,
ekteki dosyaları inceleyebilirmisiniz,elimde olanlar bunlar.
iyi çalışmalar.
ekteki dosyaları inceleyebilirmisiniz,elimde olanlar bunlar.
iyi çalışmalar.
resimler excel içerisinde , mail de ekli dosya olarak excel şeklinde gönderilecek
her satıra farklı klasörlerden resim çagırıcam bu dosya tam olarak karşılık gelmiyor...
Mevcut kullandığım pc de outlook kurulu değil ekli dosyayı inceleyiniz.
bu dosya tam istediğim gibi fakat dosya yolunu gösteriyor , excel içersinde resmin kendisi çıkmıyor.
Mail ile dosya olarak gideceğin den, gerek duymadım. H hücresinde hangi birine resim sigdirabileceksiniz. Hücreye resim eklenir, sığdırılır ama küçük olur anlaşılmaz. Yinede kodları revize ederiz.
yani H hücresine çagırdığım resimler , mesela 900*600 çözünürlüğünde gelsin şeklinde olabilir mi. 
resim getir ile bir şekilde şimdilik oldu galiba.teşekkürler...allah razı olsun
yani H hücresine çagırdığım resimler , mesela 900*600 çözünürlüğünde gelsin şeklinde olabilir mi.
Dosyanızın son hali ektedir. Mail göndermede bazı hatalar vardı, düzeltildi. Her satıra ayrı ayrı resim ekleyip ilgili kişiye gönderme testi de outlooktan yaptım, sonuç başarılı. Resimler excelde istemiş olduğunuz ölçüde ekleniyor.
şuan dosya bozuk açılamıyor hatası veriyor..
Dosya bende normal açılıyor ben yinede Üst mesajda düzeltme yaparak dosyayı değiştirdim.
Sayfanın kod editörüne aşağıdaki kodu ekleyin.
VBA:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 8 Then
Filt = "Resim Files (*.jpg*),*.png*"
FilterIndex = 10
Title = "Dosya Seçin"
dosyaadi = Application.GetOpenFilename(FileFilter:=Filt, _
FilterIndex:=FilterIndex, Title:=Title, MultiSelect:=True)
If Not IsArray(dosyaadi) Then
MsgBox ".Dosya seçmediniz", vbInformation + vbMsgBoxRtlReading, "Www.ExcelDestek.Com"
Exit Sub
End If
Dosya = dosyaadi(1)
ActiveCell = Dosya
On Error Resume Next
Set pic = ActiveSheet.Pictures.Insert(Dosya)
On Error GoTo 0
If Not pic Is Nothing Then
Set Rng = ActiveCell
With pic
.Height = Rng.Height
.Width = Rng.Width
.Left = Rng.Left
.Top = Rng.Top
h = 75 * (Val(900) + 1500) / 2000
.Height = h
w = 75 * (Val(300) + 1500) / 2000
.Width = w
End With
End If
End If
End SubModule kod editörüne;
VBA:
Sub ExcelDepo()
son = Cells(Rows.Count, "I").End(xlUp).Row
ilk = 2
For i = 2 To son + Cells(son, "I").Value
'If Not i = son + Cells(son, "I").Value Then
If Not Cells(i, 3) = Cells(i + 1, 3) And Not "" = Cells(i + 1, 3) Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = Cells(ilk, 3).Value
.CC = ""
.BCC = ""
.Subject = "konu nedir"
.Body = "mesajınız"
' .HtmlBody = ""
sonx = i
For j = ilk To sonx
.Attachments.Add Cells(j, "h").Value
Next j
.display
' .Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
ilk = i + 1
End If
If i = son + Cells(son, "I").Value Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = Cells(ilk, 3).Value
.CC = ""
.BCC = ""
.Subject = "konu nedir"
.Body = "mesajınız"
' .HtmlBody = ""
'sonx = i
For j = 4 To 7
.Attachments.Add Cells(j, "h").Value
Next j
.display
' .Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End If
Next i
End Sub
Moderatörün son düzenlenenleri:
Çözüm
- Durum