Sayın kullanıcaılar,
Ekteki
Access form üzerinden mail atmak istiyorum.
Vba veya Makro ile fark etmez. burada benim yapamadığım formdaki tabloyu maile yazdırmak.
yardımlarınız bekliyorum
Şimdiden teşekkürler.
öncelikle referanslardan Microsof ActiveX Data Object x.x library eklenmeli
çalışmanıza modül ekleyip modüle aşağıdaki kodu yazın
Function GenHTMLTable() As String ' (sQuery As String) As String
Dim RS As ADODB.Recordset
Dim Fld As ADODB.Field
Set RS = New ADODB.Recordset
sQuery = " SELECT Table1.ID, Table1.ADI, Table1.SOYADI, Table1.NOTE FROM Table1;"
On Error GoTo Error_Handler
RS.Open sQuery, CurrentProject.Connection
RS.MoveFirst
With RS
sHTML = "<table>" & vbCrLf
sHTML = sHTML & vbTab & "<tr>" & vbCrLf
For Each Fld In RS.Fields 'loop through all the fields of the tables
sHTML = sHTML & vbTab & vbTab & "<th>" & Fld.Name & "</th>" & vbCrLf
Next
sHTML = sHTML & vbTab & "</tr>" & vbCrLf
If .RecordCount <> 0 Then
Do While Not .EOF
sHTML = sHTML & vbTab & "<tr>" & vbCrLf
For Each Fld In RS.Fields 'loop through all the fields of the tables
sHTML = sHTML & vbTab & vbTab & "<td>" & Fld.Value & "</td>" & vbCrLf
Next
sHTML = sHTML & vbTab & "</tr>" & vbCrLf
.MoveNext
Loop
End If
sHTML = sHTML & "</table>"
End With
GenHTMLTable = sHTML
Error_Handler_Exit:
On Error Resume Next
If Not RS Is Nothing Then
RS.Close 'Close the recordset
Set RS = Nothing
End If
' If Not db Is Nothing Then Set db = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: GenHTMLTable" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function
mail butonunun kodu
Private Sub Command0_Click()
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
With MailOutLook
.To = Me.Text42
.subject = Me.Text46
.HTMLBody = GenHTMLTable
'.DeleteAfterSubmit = True 'This would let Outlook send th note without storing it in your sent bin
.Send
End With
'MsgBox MailOutLook.Body
MsgBox ""
Exit Sub
email_error:
MsgBox "An error was encountered." & vbCrLf & "The error message is: " & Err.Description
Resume Error_out
Error_out:
'Debug.Print GenHTMLTable
End Sub
dilerim işinize yarar
Çok teşekkür ediyorum tam da istediğim gibi elinize sağlık