Mailin ardından makrolar silinsin

[qwert11]

merhaba arkadaşlar ekde gönderdiğim dosyada veri tabanına sayım eklemelrini yaptıktan sonra sonra e-mail olarak atnam gerekmekte fakat giden emailde makroların olmaması gerekmekte sitede aradım ; ya var ben bulamadım yada yok eğer arkadaşlar yardımcı olursanız sevinirim yada bana nasıl arama yapmam gerektiğini belirtirseniz sizleride zahmete sokmadan sıkıntımı halletmiş olaccağım

tekrarlamada fayda görüyorum ek olarak giden çalışma kitabında makrolar olmayacak

 

[Murat OSMA]

Şu kodları, ister dosyayı kaydetme kodlarından sonra, ister dosya kapanışına, isterseniz de dosya açılışına yazabilirsiniz;

Sub Makrolari_sil()
    Dim vbc As Object
    Dim wks As Worksheet
    Dim dlg As DialogSheet
    With ActiveWorkbook.VBProject
        For Each vbc In .VBComponents
            Select Case vbc.Type
                Case 1, 2, 3
                .VBComponents.Remove vbc
                Case 100
                vbc.CodeModule.DeleteLines 1, vbc.CodeModule.CountOfLines
            End Select
        Next vbc
    End With
    Application.DisplayAlerts = False
    For Each wks In Excel4MacroSheets
        wks.Delete
    Next
    For Each dlg In DialogSheets
        dlg.Delete
    Next
 Application.DisplayAlerts = True
 End Sub

 

[qwert11]

SAYIN MURAT OSMA CEVABINIZ İÇİN TEŞEKKÜRLER LAKİN EKDE GÖNDERİLEN EXCEL'İN MAKROLARI SİLİNMESİ GEREKLİ AKAT YARDIMCI OLDUĞUNUZ MAKRODA ANA DOSYAMIZIN MAKROLARI SİLİNMEKTE.


AŞAĞIDA İNTERNETTTEN BULDUĞUM ANA DOSYANIN BİR KOPYASINI MAİL OLARAK ATAN MAKRO VAR SİZİNKİ İLE ONU BİRLEŞTİRMEYE ÇALIŞTIM AMA BAŞARAMADIM FİKİR VERMESİ AÇISINDAN EKLEDİM ZİRA SİZİN GİBİ ÜSTADLARA FİKİR VERMEK DAHA HADDİM DEĞ

Şu kodları, ister dosyayı kaydetme kodlarından sonra, ister dosya kapanışına, isterseniz de dosya açılışına yazabilirsiniz;

Sub Makrolari_sil()
    Dim vbc As Object
    Dim wks As Worksheet
    Dim dlg As DialogSheet
    With ActiveWorkbook.VBProject
        For Each vbc In .VBComponents
            Select Case vbc.Type
                Case 1, 2, 3
                .VBComponents.Remove vbc
                Case 100
                vbc.CodeModule.DeleteLines 1, vbc.CodeModule.CountOfLines
            End Select
        Next vbc
    End With
    Application.DisplayAlerts = False
    For Each wks In Excel4MacroSheets
        wks.Delete
    Next
    For Each dlg In DialogSheets
        dlg.Delete
    Next
 Application.DisplayAlerts = True
 End Sub

ve aşağıda da bulduğum mail atma kodu var ikisini birleştirirsek sanırım olacak ama ben beceremedim

Dim wb1 As Workbook
Dim wb2 As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim OutApp As Object
Dim OutMail As Object

Set wb1 = ActiveWorkbook

If Val(Application.Version) >= 12 Then
If wb1.FileFormat = 51 And wb1.HasVBProject = True Then
MsgBox "There is VBA code in this xlsx file, there will" & vbNewLine & _
"be no VBA code in the file you send. Save the" & vbNewLine & _
"file first as xlsm and then try the macro again.", vbInformation
Exit Sub
End If
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Make a copy of the file/Open it/Mail it/Delete it
'If you want to change the file name then change only TempFileName
TempFilePath = Environ$("temp") & "\"
TempFileName = "Copy of " & wb1.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
FileExtStr = "." & LCase(Right(wb1.Name, _
Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))

wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = "ron@debruin.nl"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add wb2.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0

wb2.Close SaveChanges:=False

'Delete the file
Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With