cleaning

[iknowu99]

i have an excel workbook called "organize_Macros.xls"
the goal is to look through all accessible xls files in specific directory and erase vba that they have. << this part seems to work except for two plus a half problems.

one problem is sometimes when openin workbooks there is a warning question: update links or not. even after unclicking the options checkmarks to update links. possible because error two

problem two is it's an actual pop up box askin about updating links

the half the problem is probably because of the prior two: excel freezes up!

some excel sheets to be cleaned are password protected. these workbooks should be saved to a new location.

also a log of read_only files would be great, this way i can manually look at them

<code>

Option Explicit

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
        (ByVal ClassName As String, ByVal WindowName As String) As Long
    
    Private Declare Function LockWindowUpdate Lib "user32" _
        (ByVal hWndLock As Long) As Long


    Sub EliminateScreenFlicker()
        Dim VBEHwnd As Long
        
        Application.VBE.MainWindow.Visible = False

        'Application Ready
     Application.ScreenUpdating = False
     Application.EnableEvents = False
     
    Application.DisplayAlerts = False
    
On Error Resume Next
    Dim IFoundFiles As Integer
    Dim Pos As String, file As String, path As String
    Dim wbSource, n
    Dim VBCodeMod
Dim VBComps
Dim VBComp
Dim vbext_ct_StdModule, vbext_ct_MSForm, vbext_ct_ClassModule
    
    
    'Start FileSearch
    With Application.FileSearch
        .LookIn = "G:\"
        .Filename = "*" & ".xls"
        .FileType = msoFileTypeExcelWorkbooks
        .SearchSubFolders = True
        .Execute
        If .Execute > 0 Then
        
            'loop through all found files
            For IFoundFiles = 1 To .FoundFiles.Count
                'set incidental variables
                Pos = InStrRev(.FoundFiles(IFoundFiles), "\")
                file = Right(.FoundFiles(IFoundFiles), Len(.FoundFiles(IFoundFiles)) - Pos)
                path = Left(.FoundFiles(IFoundFiles), Pos)

                 Workbooks.Open Filename:=Workbooks.Open(path & file), UpdateLinks:=xlUpdateLinksNever
                 Set wbSource = ActiveWorkbook

If wbSource.ReadOnly Then
    wbSource.Close False
Else

Set VBComps = wbSource.VBProject.VBComponents
For Each VBComp In VBComps
   Select Case VBComp.Type
      Case vbext_ct_StdModule, vbext_ct_MSForm, _
            vbext_ct_ClassModule
         VBComps.Remove VBComp
      Case Else
         With VBComp.CodeModule
            .DeleteLines 1, .CountOfLines
         End With
   End Select
Next VBComp
                    wbSource.Close True
End If
'Skip:
            Next IFoundFiles
            
        End If
            
    End With
      
    End Sub

</code>