Aktif Sayfayı e-mail ile gönder

[ockucukay]

hocam birde ekte gönderdiğim dosyaları bir inceleyin, belki işinize yarar.

 

[omeryılmaz]

Saygı değer Hocalarım
Sizlerin desteği ile Sağlık Ocağımıza hazırlamış olduğum, UserFormlu dökümanda Aktif sayfayı E Maile gönder dediğimde Aktif sayfa ile birlikte Moduller ve ThisWorkbook ta kayıtlı

Private Sub Workbook_Open()
On Error Resume Next
Application.Visible = False
UserForm2.Show
UserForm2.MultiPage1.Value = 0
tkrm.SetFocus
End Sub

koduda gittiği için karşı tarafta yine User ekranlı benim formum çıkmaktadır.

Benim isteğim Karşı tarafta sadece aktif sayfadaki UserFormla doldurulan Evrakın (Sayfanın) gitmesi....


Private Sub CommandButton43_Click()
Worksheets("TALASEMİ").Select
Dim bool As Boolean
strRefPath = "C:\Program Files\Microsoft Office\OFFICE12\msoutl.olb" 'ADO
bool = False
For Each ref In ThisWorkbook.VBProject.References
If ref.fullPath = strRefPath Then bool = True
Next
' 'MsgBox "kontroller tamamlandı.": Exit Sub
'<<<<<<<<<<<<<<<<<<<<<<<İŞLEMLER>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Dim OutApp As Outlook.Application
Dim NewMail As Outlook.MailItem
Dim ShName As String, WbName As String
Dim i As Integer
Dim ModX As Object, VBComp As Object

ShName = ActiveSheet.Name
'WbName = "C:\Users\CASPER\Desktop" & ShName & ".xls"
WbName = "C:\" & ShName & ".xls"
ThisWorkbook.SaveCopyAs WbName

Application.DisplayAlerts = False
Workbooks.Open WbName

For i = Sheets.Count To 1 Step -1
If ActiveWorkbook.Sheets(i).Name <> ShName Then Sheets(i).Delete
Next

On Error Resume Next
For Each ModX In ActiveWorkbook.VBProject.VBComponents
Set VBComp = ActiveWorkbook.VBProject.VBComponents(ModX.Name)
ActiveWorkbook.VBProject.VBComponents.Remove VBComp
Next
On Error GoTo 0
Application.DisplayAlerts = True

ActiveWorkbook.Close SaveChanges:=True

Set OutApp = New Outlook.Application
Set NewMail = CreateItem(olMailItem)

With NewMail
adr = "omerylzom@gmail.com"
.To = adr
.Subject = "Çorlu 7 No'lu Sağlık Ocağı Tabipliği"
.Body = "Bu e-mail eki Hemoglobinopati Kontrol Programı kapsamında, corlu.7nso Tabipliğince alınan kanların takibi ve e posta ile, ilgili Kuruma otomotik aktarılması için, hazırlanmış programdır. EKİ : 'Talasemi Tarama istek formudur."
.Attachments.Add WbName
.Save
.Send
End With

Set NewMail = Nothing
Set OutApp = Nothing
Set VBComp = Nothing
Kill WbName
MsgBox "Bu Mail ile " & adr & " adresine " & ShName & " sayfası gönderildi."
End Sub


Şimdiden yardımlarınız ve ilginiz için şükranlarımı sunuyorum... Saygılar