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.

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

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

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.

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