Excel'den Mail Atan Makronun Özelleştirilmesi

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Kod:
wb2.Names(i).Delete
Next
satırlarından sonra aşağıdakileri ilave edin ....

Kod:
    Set MyMod = wb2.VBProject.VBComponents("Module1")
    wb2.VBProject.VBComponents.Remove MyMod
    wb2.Close , SaveChanges:=True
    Set MyMod = Nothing
Kodların yazıldığı modül ismi eğer Module1 değilse, yukarıda tırnak içindeki yere modül adını yazın.
 
Katılım
3 Mayıs 2005
Mesajlar
453
Excel Vers. ve Dili
2010 - Eng
herkese teşekkür ederim. htsumer'in gönderdiğini uyarlayarak ve sonunda makroyu bir module yazarak aşağıdaki şekilde halletim.
Kod:
Sub Mail_Workbook_2()
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim wbname As String
    Dim Sil As VBIDE.VBComponent
    Addr = Array("a@referansymm.com.tr", "m@referansymm.com.tr")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Sheets(1).Range("A1").Select
    Selection.Copy
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWorkbook.Password = ""
    
    Set wb1 = ActiveWorkbook
    wbname = "C:/" & _
    Format(Now, "dd.mm.yyyy") & ".xls"
    wb1.SaveCopyAs wbname
    
    Set wb2 = Workbooks.Open(wbname)
    With wb2
        For i = wb2.Names.Count To 1 Step -1
        wb2.Names(i).Delete
        Next

For Each Sil In ActiveWorkbook.VBProject.VBComponents
    If Sil.Type = vbext_ct_StdModule Then
      ActiveWorkbook.VBProject.VBComponents.Remove Sil
End If
Next Sil
    Sheets(1).Range("A1").Select
        .SendMail Addr, Format(Now, "dd.mm.yyyy") & " Tarihli Rapor"
        .ChangeFileAccess xlReadOnly
        Kill .FullName
        .Close False
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Sheets("GENEL").Range("A1").Value = "=today()"
    ActiveWorkbook.Password = "i"
End Sub
Microsoft Visual Basic For Applications Extensibility referansı ve
Makro-->Güvenilen Yayımcılar->Visual Basic Project Erişimine Güven kutucukları işaretlenecek.
 
Katılım
3 Mayıs 2005
Mesajlar
453
Excel Vers. ve Dili
2010 - Eng
Haluk' Alıntı:
Kod:
wb2.Names(i).Delete
Next
satırlarından sonra aşağıdakileri ilave edin ....

Kod:
    Set MyMod = wb2.VBProject.VBComponents("Module1")
    wb2.VBProject.VBComponents.Remove MyMod
    wb2.Close , SaveChanges:=True
    Set MyMod = Nothing
Kodların yazıldığı modül ismi eğer Module1 değilse, yukarıda tırnak içindeki yere modül adını yazın.
thisworkbook daki Workbook_open makroyu sildiremedim
 

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Yukarıdaki mesajımda belirttiğim yere, daha önce önerdiğim kodların yerine aşağıdaki kodları yerleştirdikten sonra deneyin ...

Kod:
    For Each MyMod In wb2.VBProject.VBComponents
        NoOfLines = MyMod.CodeModule.CountOfLines
        MyMod.CodeModule.DeleteLines 1, NoOfLines
        If Not MyMod.Type = 100 Then
            wb2.VBProject.VBComponents.Remove MyMod
        End If
    Next
    wb2.Close SaveChanges:=True
    Set MyMod = Nothing
 
Katılım
3 Mayıs 2005
Mesajlar
453
Excel Vers. ve Dili
2010 - Eng
çok teşekkürler Haluk
 
Üst