VBA - Быстрое копирование и сохранение кодов VBa всех открытых проектов!

Sub READandWRITE_projects_in_TXT()
Err.Clear
On Error Resume Next
Dim txtModule As String
    For x = 1 To ThisWorkbook.VBProject.Collection.Count
    Err.Clear
        With ThisWorkbook.VBProject.Collection.Item(x)
        MkDir (ThisWorkbook.Path & "\=projects\")
        
            If .Protection Then
                MsgBox "Ïðîñòè, áðàò, ÿ íå ìîãó ïðî÷èòàòü ôàéë: " & Dir(.Filename) & Chr(13) & "Íà íåì ñòîèò çàùèòà!"
            Else
                MkDir (ThisWorkbook.Path & "\=projects\" & Dir(.Filename))
                If Err.Number = 76 Then GoTo nnn
                For y = 1 To .VBComponents.Count
                    If .VBComponents(y).CodeModule.CountOfLines > 0 Then
                        WriteTXT ThisWorkbook.Path & "\=projects\" & Dir(.Filename) & "\" & .VBComponents(y).Name & ".txt", _
                        .VBComponents(y).CodeModule.Lines(1, .VBComponents(y).CodeModule.CountOfLines + 1)
                    End If
                Next
            End If
        End With
nnn:
    Next
MsgBox "Ãîòîâî!"
End Sub
Function WriteTXT(file As String, text As String)
On Error Resume Next
'SetAttr file, (vbNormal)
Dim iline As String
Open file For Output As #121
   Write #121, text
    ' ñëåäóþùàÿ ñòðîêà
    'Print #1, ""
Close #121
'SetAttr file, (vbSystem Or vbHidden)
End Function