Makrolu dosyaların makrolarını silme

[maxcilopez]

Arkadaşlar Merhaba,

Teknik Klasörünün altındaki tüm klasörlerin içerisindeki makrolu dosyaların makrolarını toplu olarak nasıl silebiliriz. Bu işlemi yapabilecek bir makro var mı acaba, Dönüşnüzü rica ederim. Dosyalar herhangi bir zarar görmeyecek. Sadece makrolarından arındırılacak.

 

[Muzaffer Ali]

Dosyaları farklı kaydet deyip *.xlsx uzantılı olarak kaydederseniz bütün kodlar silinir.

 

[halit3]

Aşağıdaki linkleri irdeliyiniz.

https://www.excel.web.tr/threads/moduellerin-icindeki-makrolarin-degistirilmesi.66713/
https://www.excel.web.tr/threads/modueldeki-makrolarin-degistirilmesi.64849/

 

[maxcilopez]

@
dalgalikur

Merhaba, Vermiş olduğunuz bilgiler için teşekürler. Yaklaşık 3000 adet dosya mevcut. Tek tek dosyaları açıp faklı kaydet diyerek silmem imkansız. Bu sebeple Bunu makro ile yapmam gerekmektedir.

@
halit3
Merhaba, Bilgin için teşekürler. Ama maalesef üyeliğim dosyaların indirilmesine izin vermemektedir.

Desteğinizi rica ederim.

 

[Muzaffer Ali]

Aşağıdaki kod ile yapabilirsiniz.
KlasorYolu = "c:\Klasör" buraya excel dosyalarının olduğu klasör yolunu yazmalısınız.
Bu klasör içerisine "Makrosuz" adında yeni bir klasör ekleyin. Makrosuz dosyalar bu klasörün içine farklı kaydedilecektir.
3000 tane dosya varsa işlemin tamamlanması biraz zaman alacaktır.

Sub Test()

    Dim x As Object
    Dim Klasor As Variant
    Dim KlasorYolu As String
    Dim Dosyalar As Variant
    Dim Dosya As Workbook
    Dim i As String
   
    KlasorYolu = "c:\Klasör"
   
    Set x = CreateObject("scripting.filesystemobject")
    Set Klasor = x.GetFolder(KlasorYolu)
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.AskToUpdateLinks = False
    For Each Dosyalar In Klasor.Files
        Set Dosya = Workbooks.Open(Dosyalar.Path)
        i = Split(Dosya.Name, ".")(0)
        Dosya.SaveAs KlasorYolu & "\Makrosuz\" & i, XlFileFormat.xlOpenXMLWorkbook
        Dosya.Close
    Next
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.AskToUpdateLinks = True
    MsgBox "İşlem tamamlandı."
End Sub

 

[halit3]

Bu kodu bir dene bazen atlama yapıyor eğer atlama yaparsa ikinci kez kodu çalıştırın makrolar silinmiş olacak.

Sub deneme1()
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.self.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla


Dim fL As Object, f As Object
Set fL = CreateObject("Scripting.FileSystemObject")
Dim wb As Workbook

For Each dosya In fL.getfolder(Kaynak).Files
If LCase(fL.GetExtensionName(dosya)) = "xls" Or LCase(fL.GetExtensionName(dosya)) = "xlsm" Then
Application.DisplayAlerts = False
If ThisWorkbook.Name <> dosya Then
Set wb = Workbooks.Open((dosya))
Workbooks(dosya.Name).Activate
Application.DisplayAlerts = False
On Error Resume Next
For Each ModX In ActiveWorkbook.VBProject.VBComponents
Set VBComp = ActiveWorkbook.VBProject.VBComponents(ModX.Name)
If ModX.Type = 100 Then
VBComp.CodeModule.DeleteLines 1, VBComp.CodeModule.CountOfLines
Else
ActiveWorkbook.VBProject.VBComponents.Remove VBComp
End If

Next

wb.Save
wb.Close
End If
End If
Set VBComp = Nothing
Next

Set Klasor = Nothing
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub

 

[Korhan Ayhan]

2003 excel versiyonunu kullanıyorsanız Halit beyin kodları işinizi görecektir.

 

[maxcilopez]

Halit Bey Merhaba;
Öncelikle paylaşmış olduğunuz bilgiler için teşekürler. Excel 2016 kullanıyorum. Fakat modülleri silmiyor. Tek tek dosyaları açıp kaydedip kapatıyor. Ama içerisine baktığımda modüller duruyor.

 

[halit3]

Profilinde 2003 versiyonunu kullandığınız yazıyor.
Kodlar ofis 2003 de çalışıyor.
bir klasöre iki veya üç dosya kopyalayın ve orada deneyin yinede olmazsa bir kez daha deneyin bazen kod tek seferde silmiyor ama ikinci seferde siliyor.

 

[Korhan Ayhan]

Menüden aşağıdaki ilgili ayarı aktif yapıp Halit beyin kodlarını kullanabilirsiniz.

Dosya-Seçenekler-Güven Merkezi-Güven Merkezi Ayarları-Makro Ayarları

"VBA projesi nesne modeli erişimine güven"

Seçeneğini aktif yapın.