Skip to main content

AccessTr.neT


Ek Data Tipli Bir Tabloda Dosyayı E-Mail Eki Yaparak Göndermek

Ek Data Tipli Bir Tabloda Dosyayı E-Mail Eki Yaparak Göndermek

Çözüldü #1
Arkadaşlar, acil yardıma ihtiyacım var.

Ekte gönderdiğim vt ile bir outlook email oluşturmaya çalışıyorum. Data tipi ek olan ve içeri gömdüğüm dosyayı outlook mail oluştururken bir türlü mail eki olarak getirtemedim. Yardımlarınızı bekliyorum.

Tesekkurler.
.rar Kisi Mail.rar (Dosya Boyutu: 1,86 MB | İndirme Sayısı: 17)
Cevapla
Çözüldü #2
mail isimli formunuza aşağıdaki fonksiyonu ekleyin sonra o fonksiyonu çağırın ve dosya1 alanında sakladığınız eklentiyi geçici olarak bir klasöre kaydedin sonrada o klasördeki dosyları ekleyin.
Bu şekilde çözülür.
Örnek olarak eklemek için zamanım yok şu anda.

Public Function SaveAttachments(strPath As String, Optional strPattern As String = "*.*") As Long
Dim dbs As DAO.Database
Dim rst As DAO.Recordset2
Dim rsA As DAO.Recordset2
Dim fld As DAO.Field2
Dim dosyaad As DAO.Field2
Dim strFullPath As String

'Get the database, recordset, and attachment field
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("select * from mail where id =" & Me.id.Value)
Set fld = rst("dosya1")
Set dosyaad = rst("id")

'Navigate through the table
Do While Not rst.EOF

'Get the recordset for the Attachments field
Set rsA = fld.Value
'Set rsA = dosyaad.Value

'Save all attachments in the field
Do While Not rsA.EOF
If rsA("FileName") Like strPattern Then
strFullPath = strPath & "\" & rsA("FileName")
dosyam = rsA("FileName")
'strFullPath = strPath & "\" & rsA("ad")
Debug.Print rsA("FileName"), rst("id")
'Make sure the file does not exist and save
If Dir(strFullPath) = "" Then
rsA("FileData").SaveToFile strFullPath
End If

'Increment the number of files saved
SaveAttachments = SaveAttachments + 1
End If

'Next attachment
rsA.MoveNext
Loop
rsA.Close

'Next record
rst.MoveNext
Loop

rst.Close
dbs.Close

Set fld = Nothing
Set rsA = Nothing
Set rst = Nothing
Set dbs = Nothing
End Function


Public dosyam As String

Private Sub Komut36_Click()
SaveAttachments ("c:\eeee")

End Sub
komşuda dülger mi var geliyor keser sesi,
ustalar konuşunca çıraklar keser sesi.
Cevapla
Çözüldü #3
Kural hocam eyvallah,

vermiş olduğun kodlarla uyarladım ve oldu. Fakat şöyle bir sıkıntım var şimdi. Veri tipi EK olursa bir sıkıntı olmuyor dosyayı dışarı verip outlook maile alabılıyorum, ancak veri tipini OLE Nesnesi seçersem dosyayı dışarı aktaramıyor. Aktaracakmış gibi oluyor, yanıt vermiyor.

Veriyi Sql Serverdan çektiğim için de veri tipi OLE geliyor. Aslında söyle bir hata veriyor. "You must use the dbSeeChanges option with OpenRecordSet when accessing a Sql Server table that has an IDENTITY column".

Sizce neden olabilir? Bir başka sorumda 3-4 adet ek için nasıl bir döngü yapmalıyım.

Şimdiden teşekkürler.

Verdiğiniz kodun düzenlemesi altta.


Public Function SaveAttachments(strPath As String, Optional strPattern As String = "*.*") As Long
Dim dbs As dao.Database
Dim rst As dao.Recordset2
Dim rsA As dao.Recordset2
Dim fld As dao.Field2
Dim dosyaad As dao.Field2
Dim strFullPath As String

Dim objOutlook As New Outlook.Application
Dim objMail As Outlook.MailItem
Dim sTitle As String, sFile As String, sErr As String

'Get the database, recordset, and attachment field
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("select * from mail where id =" & Forms!frmMail!id.Value)
Set fld = rst("dosya1")
Set dosyaad = rst("id")
Set objMail = objOutlook.CreateItem(olMailItem)
On Error Resume Next

'Navigate through the table
Do While Not rst.EOF

'Get the recordset for the Attachments field
Set rsA = fld.Value
'Set rsA = dosyaad.Value

'Save all attachments in the field
Do While Not rsA.EOF
If rsA("FileName") Like strPattern Then
strFullPath = strPath & "\" & rsA("FileName")
dosyam = rsA("FileName")
'strFullPath = strPath & "\" & rsA("ad")
Debug.Print rsA("FileName"), rst("id")
'Make sure the file does not exist and save
If Dir(strFullPath) = "" Then
rsA("FileData").SaveToFile strFullPath
End If

'Increment the number of files saved
SaveAttachments = SaveAttachments + 1
End If

'Next attachment
rsA.MoveNext
Loop
rsA.Close

'Next record
rst.MoveNext
Loop

rst.Close
dbs.Close

Set fld = Nothing
Set rst = Nothing
Set dbs = Nothing

With objMail
.To = Forms!frmMail!Metin10
.Subject = Forms!frmMail!Metin24
.ReadReceiptRequested = False
.HTMLBody = Forms!frmMail!text
.Display
sFile = strFullPath
sTitle = "Latest Report"
With .Attachments.Add(sFile, olByValue)
.DisplayName = sTitle
End With
End With
objMail = Nothing
objOutlook = Nothing

Set rsA = Nothing

Kill strFullPath

End Function

Private Sub Komut36_Click()
DoCmd.RunCommand acCmdSaveRecord
gigi.Value = -1
gitmedi.Visible = False
gitti.Visible = True
Me.Refresh
SaveAttachments ("c:\Temp")
End Sub
Cevapla
Çözüldü #4
Bu söylediğinizle ilgili Seruz hocanın bir desen örneği vardı onu bulup yapmamız lazım. Ben araştırıp bulduğumda eklerim. Kolay gelsin.
komşuda dülger mi var geliyor keser sesi,
ustalar konuşunca çıraklar keser sesi.
Cevapla
Çözüldü #5
Merhabalar, Sanırım aşağıdaki konudaki örnekten bahsediyorsunuz.
formdaki bilgileri ilgili kişiye eposta olarak gönderme
3.sayfada örnek dosya, 5.sayfada mail örneğinin resmi var.

Ayrıca aynı örnek veya benzerini aşağıdaki konuda bulabilirsiniz.
Ünvana Göre Mail Gönderimi
Bildiğini bilenin arkasından git, bildiğini bilmeyeni uyar, bilmediğini bilene öğret, bilmediğini bilmeyenden kaç.
Konfüçyüs
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da