Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2273
  • Last Modified:

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

0
mato01
Asked:
mato01
1 Solution
 
viralypatelCommented:
Record another macro with the following steps:
1. Run DeleteAllVBACode
2. Click Save As
3. Save the file.
0
 
mato01Author Commented:
Will this loop thru all the files in the folder. I'm trying not to have to do this process 24 times.
0
 
andrewssd3Commented:
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.
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
dlmilleCommented:
@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
0
 
dlmilleCommented:
Apologies.  I rectified a couple items.  I transformed a procedure that converted .XLSX to .XLS and thought I got everything... But, line 19 has the wrong text, and I needed to set one flag - a bug I found in the prior solution that hadn't been uncovered associated with the overwrite option...

This one's clean and I just tested (again :)

Dave
loopAndConvert-no-VBA-r2.xlsm
0
 
mato01Author Commented:
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?
0
 
dlmilleCommented:
@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
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now