Solved

Delete all VBA in all workbooks in a folder.

Posted on 2011-09-22
7
2,194 Views
Last Modified: 2012-05-12
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
Comment
Question by:mato01
7 Comments
 
LVL 12

Expert Comment

by:viralypatel
ID: 36584997
Record another macro with the following steps:
1. Run DeleteAllVBACode
2. Click Save As
3. Save the file.
0
 

Author Comment

by:mato01
ID: 36585113
Will this loop thru all the files in the folder. I'm trying not to have to do this process 24 times.
0
 
LVL 17

Expert Comment

by:andrewssd3
ID: 36585160
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
Best Practices: Disaster Recovery Testing

Besides backup, any IT division should have a disaster recovery plan. You will find a few tips below relating to the development of such a plan and to what issues one should pay special attention in the course of backup planning.

 
LVL 41

Expert Comment

by:dlmille
ID: 36585620
@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
 
LVL 41

Accepted Solution

by:
dlmille earned 250 total points
ID: 36585651
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
 

Author Comment

by:mato01
ID: 36710075
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
 
LVL 41

Expert Comment

by:dlmille
ID: 36975643
@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

ScreenConnect 6.0 Free Trial

Discover new time-saving features in one game-changing release, ScreenConnect 6.0, based on partner feedback. New features include a redesigned UI, app configurations and chat acknowledgement to improve customer engagement!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Make a Cell act like a Date 7 39
Dropbox in Windows Server 2008 4 31
VBA Fill Blanks with text from another cell 6 21
Excel - remove duplicates 1 13
Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

809 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question