asked on

Delete all VBA in all workbooks in a folder.

I found the attached code to delete all the macros in a workbook.

I have a folder with 24 workbooks, that I need to apply the Sub DeleteAllVBACode() code and then save those 24 workbooks to another folder after the macros have been stripped.

Sub DeleteAllVBACode()
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim CodeMod As VBIDE.CodeModule
        
        Set VBProj = ActiveWorkbook.VBProject
        
        For Each VBComp In VBProj.VBComponents
            If VBComp.Type = vbext_ct_Document Then
                Set CodeMod = VBComp.CodeModule
                With CodeMod
                    .DeleteLines 1, .CountOfLines
                End With
            Else
                VBProj.VBComponents.Remove VBComp
            End If
        Next VBComp
    End Sub

Open in new window

viralypatel

Record another macro with the following steps:
1. Run DeleteAllVBACode
2. Click Save As
3. Save the file.

mato01

ASKER

Will this loop thru all the files in the folder. I'm trying not to have to do this process 24 times.

andrewssd3

If you have Excel 2007 or later, you could just save as the non-macro enabled format (.XLSX), and this would remove all code. Be aware that the code you have also requires that your Macro security settings have 'Trust Access to VBA project' checked.

dlmille

@andrewssd3 - agreed

Adapted from this solution http:/Q_27289693.html

Here's the primary code you can use for that conversion:

Option Explicit
Sub loopAndConvert()
Dim fPath As String
Dim fName As String, fSaveAsFilePath As String, fOriginalFilePath As String
Dim wBook As Workbook, fFilesToProcess() As String
Dim numconverted As Long, cntToConvert As Long, i As Long
Dim killOnSave As Boolean, xMsg As Long, overWrite As Boolean, pOverWrite As Boolean
Dim silentMode As Boolean


    xMsg = MsgBox("Do you want prompting?" & Chr(10) & Chr(10) & "Silent Mode:  Overwrite existing files, and Deletes when processing complete", vbYesNo, "Hit NO for Silent mode")
    silentMode = False
    If xMsg = vbNo Then
        silentMode = True
    End If
    
    Application.DisplayAlerts = False 'no user prompting, taking all defaults
    
    fPath = GetFolderName("Select Folder for XLSX to XLS conversion")
    
    If fPath = "" Then
        MsgBox "You didn't select a folder", vbCritical, "Aborting!"
        Exit Sub
    Else
        fName = Dir(fPath & "\*.xlsm")
        If fName = "" Then
            MsgBox "There aren't any .XLSM files in the " & fPath & " directory", vbCritical, "Aborting"
            Exit Sub
        Else

            Do
                ReDim Preserve fFilesToProcess(cntToConvert) As String
                fFilesToProcess(cntToConvert) = fName
                cntToConvert = cntToConvert + 1
                
                fName = Dir
                
            Loop Until fName = ""
            
            If Not silentMode Then
                xMsg = MsgBox("There are " & cntToConvert & " .XLSM files to convert to .XLSX.  Do you want to delete the .XLSM files as they are processed?", vbYesNoCancel, "Select an Option")
                killOnSave = False 'already false, but just a reminder this is in here!
                
                If xMsg = vbYes Then
                    killOnSave = True
                    pOverWrite = True
                ElseIf xMsg = vbCancel Then
                    GoTo processComplete
                End If
            Else
                killOnSave = True
                pOverWrite = True
            End If
            
            Application.EnableEvents = False 'turn off events so macros don't fire on excel file opens
            
            For i = 0 To cntToConvert - 1
            
                Application.StatusBar = "Processing: " & i + 1 & " of " & cntToConvert & " file: " & fName
                
                fName = fFilesToProcess(i)
                'open and convert file
                On Error GoTo errHandler
                fOriginalFilePath = fPath & "\" & fName
                
                'you could also check to see if the save as file already exists, before you open convert and save on top!
                overWrite = False
                fSaveAsFilePath = fPath & "\" & Mid(fName, 1, Len(fName) - 5) & ".XLSX"
                If Not pOverWrite Then
                    If FileFolderExists(fSaveAsFilePath) Then
                        xMsg = MsgBox("File: " & fSaveAsFilePath & " already exists, overwrite?", vbYesNoCancel, "Hit Yes to Overwrite, No to Skip, Cancel to quit")
                        If xMsg = vbYes Then
                            overWrite = True
                        ElseIf xMsg = vbCancel Then
                            GoTo processComplete
                        End If
                    End If
                Else
                    overWrite = pOverWrite
                End If
                If overWrite Then
                    Set wBook = Application.Workbooks.Open(fOriginalFilePath)

                    wBook.SaveAs Filename:=fSaveAsFilePath, FileFormat:=xlExcel8
                    wBook.Close savechanges:=False
                    numconverted = numconverted + 1
                    
                    'optionally, you can delete the file you converted from
                    If killOnSave Then
                        Kill fOriginalFilePath
                    End If
                End If
                
            Next i
        End If
    End If
    
processComplete:
    On Error GoTo 0
    MsgBox "Completed " & numconverted & " .XLSM to .XLSX conversions", vbOKOnly
    Application.EnableEvents = True 'uncomment if doing other conversions where macros are involved in source workbooks
    Application.StatusBar = False
    Application.DisplayAlerts = True
    Exit Sub
    
errHandler:
    Application.StatusBar = False
    MsgBox "For some reason, could not open/save the file: " & fPath & "\" & fName, vbCritical, "Aborting!"
    Resume processComplete
    
End Sub

Open in new window

See attached and Enjoy!

Dave
loopAndConvert-no-VBA-r1.xlsm

ASKER CERTIFIED SOLUTION

dlmille

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

mato01

ASKER

I can't get this to run. I saved it down to my directory, and then clicked the Loop and Convert button. Nothing happened. Is there away for this process to happen without me having to click a button?

dlmille

@mato01 - See article here: http:/A_8269.html, which built upon this solution. Please vote Yes if helpful :)

The article/attached code provides support to remove macros from .XLS as well as .XLSM files...

Cheers,

Dave