Çözüldü klasörden fotograf çağırma ve mail gönderme

wolfret

Yeni Üye
Üye
Katılım
8 Eki 2018
Mesajlar
33
Tepki puanı
2
Puanları
8
Excel Versiyonu, Dili
Bilinmiyor
merhaaba,

excel içerisine, klasörlerdeki fotografları alıcam ve sonrada bu excel içerisinde bulunan mail adreslerine . gönderim yapmak istiyorum.....
 

metehan8001

Feyzullah - XD Yönetim
Yönetici
Forum Yöneticisi
Katılım
1 Eki 2018
Mesajlar
214
Tepki puanı
103
Puanları
43
Konum
Osmaniye
Web Sitesi
www.exceldepo.com
Excel Versiyonu, Dili
Excel 2016 TR
Bir tek resim mi yoksa birden fazla mı?
Ayrıca örnek dosya olursa daha hızlı ilerleriz.
 

metehan8001

Feyzullah - XD Yönetim
Yönetici
Forum Yöneticisi
Katılım
1 Eki 2018
Mesajlar
214
Tepki puanı
103
Puanları
43
Konum
Osmaniye
Web Sitesi
www.exceldepo.com
Excel Versiyonu, Dili
Excel 2016 TR
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.
 

Hayate

Yeni Üye
Üye
Katılım
2 Eki 2018
Mesajlar
1
Tepki puanı
1
Puanları
3
Excel Versiyonu, Dili
Bilinmiyor
Merhaba,
ekteki dosyaları inceleyebilirmisiniz,elimde olanlar bunlar.

iyi çalışmalar.
 

Ekli dosyalar

wolfret

Yeni Üye
Üye
Katılım
8 Eki 2018
Mesajlar
33
Tepki puanı
2
Puanları
8
Excel Versiyonu, Dili
Bilinmiyor
resimler excel içerisinde , mail de ekli dosya olarak excel şeklinde gönderilecek
 

wolfret

Yeni Üye
Üye
Katılım
8 Eki 2018
Mesajlar
33
Tepki puanı
2
Puanları
8
Excel Versiyonu, Dili
Bilinmiyor
her satıra farklı klasörlerden resim çagırıcam bu dosya tam olarak karşılık gelmiyor...
 

wolfret

Yeni Üye
Üye
Katılım
8 Eki 2018
Mesajlar
33
Tepki puanı
2
Puanları
8
Excel Versiyonu, Dili
Bilinmiyor
bu dosya tam istediğim gibi fakat dosya yolunu gösteriyor , excel içersinde resmin kendisi çıkmıyor.
 

metehan8001

Feyzullah - XD Yönetim
Yönetici
Forum Yöneticisi
Katılım
1 Eki 2018
Mesajlar
214
Tepki puanı
103
Puanları
43
Konum
Osmaniye
Web Sitesi
www.exceldepo.com
Excel Versiyonu, Dili
Excel 2016 TR
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.
 

wolfret

Yeni Üye
Üye
Katılım
8 Eki 2018
Mesajlar
33
Tepki puanı
2
Puanları
8
Excel Versiyonu, Dili
Bilinmiyor
yani H hücresine çagırdığım resimler , mesela 900*600 çözünürlüğünde gelsin şeklinde olabilir mi. :cautious:
 

wolfret

Yeni Üye
Üye
Katılım
8 Eki 2018
Mesajlar
33
Tepki puanı
2
Puanları
8
Excel Versiyonu, Dili
Bilinmiyor
resim getir ile bir şekilde şimdilik oldu galiba.teşekkürler...allah razı olsun
 

metehan8001

Feyzullah - XD Yönetim
Yönetici
Forum Yöneticisi
Katılım
1 Eki 2018
Mesajlar
214
Tepki puanı
103
Puanları
43
Konum
Osmaniye
Web Sitesi
www.exceldepo.com
Excel Versiyonu, Dili
Excel 2016 TR
yani H hücresine çagırdığım resimler , mesela 900*600 çözünürlüğünde gelsin şeklinde olabilir mi. :cautious:
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.
 

Ekli dosyalar

wolfret

Yeni Üye
Üye
Katılım
8 Eki 2018
Mesajlar
33
Tepki puanı
2
Puanları
8
Excel Versiyonu, Dili
Bilinmiyor
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..
 

metehan8001

Feyzullah - XD Yönetim
Yönetici
Forum Yöneticisi
Katılım
1 Eki 2018
Mesajlar
214
Tepki puanı
103
Puanları
43
Konum
Osmaniye
Web Sitesi
www.exceldepo.com
Excel Versiyonu, Dili
Excel 2016 TR
ş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.
PHP:
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 Sub
Module kod editörüne;

PHP:
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
 
Son düzenleme:

wolfret

Yeni Üye
Üye
Katılım
8 Eki 2018
Mesajlar
33
Tepki puanı
2
Puanları
8
Excel Versiyonu, Dili
Bilinmiyor
teşekkür ederim emekleriniz için...
 
Üst