Come trovare le cartelle di lavoro contenenti macro

L’azienda di Riccardo, come molte altre, utilizza molto Excel. In effetti, hanno migliaia e migliaia di cartelle di lavoro di Excel che hanno raccolto nel corso degli anni. Riccardo ha bisogno di un modo per scoprire quali di queste cartelle di lavoro contengono macro VBA, senza la necessità di aprire e ispezionare ciascuna cartella di lavoro individualmente. Si chiede se esista un modo semplice per farlo.

Un modo piuttosto semplicistico per trovare tutte le cartelle di lavoro contenenti macro è cercare semplicemente tutti i file che utilizzano le estensioni XLSM o XLSB. Le cartelle di lavoro che contengono macro devono essere archiviate in file che utilizzano queste estensioni. Sebbene non sia infallibile al 100%, è un buon punto di partenza.

Puoi anche utilizzare le funzionalità di ricerca di Windows (al di fuori di Excel) e cercare qualsiasi file che contenga il testo “End Sub” o “End Function“. Ciò identificherà rapidamente qualsiasi potenziale cartella di lavoro candidata, poiché qualsiasi procedura VBA deve utilizzare una di queste due istruzioni alla fine (tuttavia, non funzionerà con i file XLSB, poiché il codice macro in essi è archiviato in un formato binario).

Se stai utilizzando cartelle di lavoro legacy (quelle sviluppate utilizzando il formato file di Excel 2003), devi effettivamente esaminare ciascuna cartella di lavoro. Questo può essere fatto a livello di codice, il che significa che potresti avere una macro che apre ogni cartella di lavoro in una directory e la esamina per vedere se sono presenti macro al suo interno.

Ad esempio, potresti creare una macro che passi attraverso ciascuno dei file in una directory e determini se il file è una cartella di lavoro di Excel. Può quindi aprire il file e verificare se contiene un progetto VBA al suo interno.

 

Sub TrovaMacro()
    Const MyName As String = "TrovaMacro"
    Const Header As String = " file con VBA nella directory della cartella di lavoro attiva:"
    Const MaxNbr As Integer = 25, MaxLen As Integer = 800
    Dim oldCM As Variant, oldAS As Variant, bIsVB As Boolean, bNext As Boolean
    Dim sThis As String, sPath As String, sFile As String
    Dim sLow As String, sExt As String, sMsg As String
    Dim sList As String, sPart As String, nList As Integer, nPart As Integer
    sThis = ThisWorkbook.Name
    With Application
        .ScreenUpdating = False
        oldCM = .Calculation
        .Calculation = xlCalculationManual
        oldAS = .AutomationSecurity
        .AutomationSecurity = msoAutomationSecurityForceDisable
        .EnableEvents = False
        sPath = ActiveWorkbook.Path & .PathSeparator
    End With
    ChDir sPath
    sFile = Dir("*.xl*")
    Do While sFile <> ""
        sLow = LCase(sFile)
        sExt = Mid(sLow, InStrRev(sLow, ".xl"))
        If Len(sExt) < 6 Then
            bIsVB = (sFile = sThis) Or (sLow = "personal.xlsb") _
                Or (sExt = ".xla") Or (sExt = ".xlam")
            If Not bIsVB Then
                On Error Resume Next
                    bIsVB = Workbooks(sFile).HasVBProject
                    If Err <> 0 Then
                        Err.Clear
                        Workbooks.Open (sPath & sFile), _
                            UpdateLinks:=False, ReadOnly:=True
                        If Err = 0 Then
                            bIsVB = ActiveWorkbook.HasVBProject
                            ActiveWorkbook.Close SaveChanges:=False
                        End If
                    End If
                On Error GoTo 0
            End If
            If bIsVB Then
                nList = nList + 1
                sList = sList & vbLf & sFile 'elenco completo
                nPart = nPart + 1
                sPart = sPart & vbLf & sFile 'elenco parziale
            End If
            If nPart = MaxNbr Or Len(sPart) > MaxLen Then
                sMsg = IIf(bNext, "Prossimo ", "Primo ") & nPart & Header & sPart
                If MsgBox(sMsg, vbOKCancel, MyName) = vbCancel Then Exit Sub
                bNext = True
                nPart = 0
                sPart = ""
            End If
        End If
        sFile = Dir
    Loop
    With Application
        .EnableEvents = True
        .AutomationSecurity = oldAS
        .Calculation = oldCM
        .ScreenUpdating = True
    End With
    If nPart = 0 And (Not bNext) Then
        MsgBox "Nessun file con VBA nella cartella della cartella di lavoro attiva", , MyName
    ElseIf nPart > 0 Then
        MsgBox (IIf(bNext, "Ultimo ", "") & nPart & Header & sPart), , MyName
    End If
    'prendi in considerazione la possibilità di copiare la sList completa
    'in un foglio di lavoro, un documento o negli appunti
End Sub

 

 

In questo esempio viene utilizzata la proprietà HasVBProject (introdotta nel modello a oggetti di Excel in Excel 2007) per determinare se il file contiene macro o meno. Al termine, la macro visualizza una finestra di messaggio che elenca i fogli di lavoro contenenti macro.

 

 

 

Tags: , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,

Ti è stato utile?