Modifying VBA code in multiple files

[nikki333]

Hi Folks

I'm trying to modify VBA Code in multiple files using VBA code

The reason for that is that i need to manage/update multiple files containing exactly the same VBA code.
For example, if i see a bug in one file, i'd like to change it and update all the other files with the same code.

So far, I found the instructions on C.Pearson quite interesting (http://www.cpearson.com/Excel/VBE.aspx). It seems that deleting code is very easy, but adding/replacing is a bit of a challenge!

For example this sub deletes all code from a workbook:

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

Which is good, but I need then to copy all code from the source workbook back into the file; and copying is more cumbersome than deleting.

The question is, if anyone has the same needs, and would like to share some code to speed up the process

[Stohan]

Hi

OffTop, but is it easier to use one workbook as the source of the code for the other books. Is the code is exactly the same.

I will have a look at your problem, and will see what I can find about that.

[nikki333]

I'm still struggling with this one. I've written two subs, one for exporting and one for importing VB code components.

As for the export (subVBKomponentenExportieren):
So far I've managed to programmatically create a folder and export each VB component ( as .txt for workbook/worksheet and .bas for standard modules).
During that procedure, each codecomponent also gets a timestamp (that is inserting one line at the top with a time stamp and an empty line after). This procedure works well, no errors.

As for the import (subVBKomponentenImportieren):
The import, on the other hand, although it used to work many times before, now produces an APPCRASH (VBE7.dll,...); sometimes it happens during the procedure, sometimes right after, and sometimes upon saving or manual compiling.
The crash-causing lines must occur after the "ERROR AFTER HERE" quite at the end of the export sub; since, at that point no break-points are allowed anymore, it's quite difficult to debug. And yes, I'm aware that for this purpose an Addin would be better, but that's not an option right now.
Any idas?

Below, you can see both subs:

'110219@141300 

Option Private Module  
Option Compare Text    
Option Explicit        
Option Base 1          

'Variablen für dieses Modul dimensionieren
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim fso As New FileSystemObject
Dim fsoTextDatei As TextStream
Dim strCodeMod As String
Dim strDateiPfad As String
Dim strCodeVersion As String
Dim strAnlage As String

'Alle VBE CodeKomponenten als individuelle Dateien exportieren (.txt für Workbook/-sheet Elemente und .bas für Standard Module)
Sub subVBKomponentenExportieren(Optional strVorgängerprozedur As String)

    'Variablen dimensionieren/speichern
    Dim strExportOrdner As String
    Dim strAnlage As String
    Dim strJahr As String

    On Error Resume Next
        strDateiPfad = Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\")) & "01_RüstCode\"
        If Not Err.Number = 0 Then
            strDateiPfad = "L:\Operations Produktion\Lindt Production Way\LPW Allgemein\99 Ted\01_Excel_In_Berarbeitung\RüstProjekt\01_RüstCode\"
            Err.Clear
        End If
    Resume 0
    strCodeVersion = Replace(Replace(Replace(Now(), ":", ""), ".", ""), " ", "")
    strJahr = Mid(strCodeVersion, 5, 4)
    strCodeVersion = Replace(strCodeVersion, strJahr, Right(strJahr, 2) & "@")
    strAnlage = wsHelfer.Range("B27")
    strExportOrdner = strDateiPfad & "RüstCode" & " " & strAnlage & " " & strCodeVersion
    Set VBProj = ThisWorkbook.VBProject
    
    'MessageBox Export bestätigen
    If strVorgängerprozedur = "btnCodeExportieren" Then
        MsgBox "Mit dieser Funktion werden alle in dieser Datei enthaltenen VBA Codekomponenten exportiert und als aktuelle CodeVersion für zukünftiges Importieren gehandhabt!" & vbNewLine & vbNewLine & _
         "Wollen Sie fortfahren?", vbInformation + vbOKCancel, "VBA Code exportieren"
    End If
    
    'Für jede Codekomponente eine CodeVersion hinzufügen (in die erste Zeile)
    For Each VBComp In VBProj.VBComponents
        Set CodeMod = VBComp.CodeModule
        With CodeMod
            If Not .CountOfLines = 0 Then
                If InStr(1, .Lines(1, 1), "@") > 0 Then
                    .ReplaceLine 1, "'" & strCodeVersion & " (Code importiert von " & strAnlage & ")"
                Else
                    .InsertLines 1, "'" & strCodeVersion & " (Code importiert von " & strAnlage & ")"
                    .InsertLines 2, " "
                End If
            Else
                .InsertLines 1, "'" & strCodeVersion & " (Code importiert von " & strAnlage & ")"
                .InsertLines 2, " "
            End If
        End With
    Next VBComp
    
    'Für jede Codekomponente eine Datei erstellen (.txt für Workbook/Worksheet Elemente und .bas für Standard Module)
    MkDir (strExportOrdner)
    For Each VBComp In VBProj.VBComponents
        With VBComp
            If .Type = vbext_ct_Document Then
                Set CodeMod = VBComp.CodeModule
                With CodeMod
                    Set fsoTextDatei = fso.CreateTextFile(strExportOrdner & "\" & .Name & ".txt")
                    strCodeMod = .Lines(1, .CountOfLines)
                    With fsoTextDatei
                        .Write strCodeMod
                        .Close
                    End With
                End With
            ElseIf .Type = vbext_ct_StdModule Then
                VBProj.VBComponents(.Name).Export Filename:=strExportOrdner & "\" & .Name & ".bas"
            End If
        End With
    Next VBComp
    
    'Codeversion in Dokumentkommentare schreiben
    ThisWorkbook.BuiltinDocumentProperties("comments").Value = strCodeVersion
    
    'Projekt kompilieren Status setzten
    wsHelfer.Range("B19") = 0
    
    'Aktuelle Datei exportieren (Backup)
    subVBKomponentenImportieren "btnDateiExportieren"

End Sub

'Alle VBE CodeKomponenten in aktuelle Datei importieren
Sub subVBKomponentenImportieren(Optional strVorgängerprozedur As String)

    'Variablen dimensionieren/speichern
    Dim datDatumAktuellerOrdner As Date
    Dim datDatumNeusterOrdner As Date
    Dim fsoImportOrdner As Object
    Dim strImportOrdner As String
    Dim strExportOrdner As String
    Dim strUpdateModul As String
    Dim objDatei As Object
    Dim fsoOrdner As Object
    On Error Resume Next
        strDateiPfad = Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\")) & "01_RüstCode\"
        strExportOrdner = Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\")) & "03_Dokumente\00_RüstListenVersionen\"
        If Not Err.Number = 0 Then
            strDateiPfad = "L:\Operations Produktion\Lindt Production Way\LPW Allgemein\99 Ted\01_Excel_In_Berarbeitung\RüstProjekt\01_RüstCode\"
            strExportOrdner = "L:\Operations Produktion\Lindt Production Way\LPW Allgemein\99 Ted\01_Excel_In_Berarbeitung\RüstProjekt\03_Dokumente\00_RüstListenVersionen\"
            Err.Clear
        End If
    Resume 0
    Set VBProj = ThisWorkbook.VBProject
    Set fsoImportOrdner = fso.GetFolder(strDateiPfad)
    Set fsoImportOrdner = fsoImportOrdner.SubFolders
   
    'Aktuelle Datei exportieren (Backup)
    strCodeVersion = ThisWorkbook.BuiltinDocumentProperties("comments").Value
    strAnlage = wsHelfer.Range("B27")
    strExportOrdner = strExportOrdner & strAnlage
    If Dir(strExportOrdner) = "" Then
        MkDir (strExportOrdner)
    End If
    ThisWorkbook.SaveCopyAs strExportOrdner & "\Rüstliste " & strAnlage & " " & strCodeVersion & ".xlsm"
    If strVorgängerprozedur = "btnDateiExportieren" Then
        MsgBox "Eine Kopie dieser Datei wurde wie folgt exportiert: " & vbNewLine & vbNewLine & _
         strExportOrdner & "\Rüstliste " & strAnlage & " " & strCodeVersion & ".xlsm" & vbNewLine & vbNewLine, vbInformation + vbOKOnly, "Datei Export"
        Exit Sub
    End If
   
    'Neusten ImportPfad ermitteln
    For Each fsoOrdner In fsoImportOrdner
        If fsoOrdner.Name Like "*@*" Then
            datDatumAktuellerOrdner = fsoOrdner.DateCreated
            If strImportOrdner = "" Then
                strImportOrdner = fsoOrdner.Path
                datDatumNeusterOrdner = datDatumAktuellerOrdner
            ElseIf datDatumAktuellerOrdner > datDatumNeusterOrdner Then
                datDatumNeusterOrdner = datDatumAktuellerOrdner
                strImportOrdner = fsoOrdner.Path
            End If
        End If
    Next fsoOrdner
    On Error Resume Next
        Set fsoOrdner = fso.GetFolder(strImportOrdner)
        strCodeVersion = Mid(strImportOrdner, InStr(1, strImportOrdner, "@") - 6, 13)
        If Not Err.Number = 0 Then
            MsgBox "Es befinden sich keine CodeVersionen in diesem Ordner!", vbInformation + vbOKOnly, "Fehlende CodeVersionen"
            Exit Sub
        End If
    Resume 0
    
'>>>ERROR AFTER HERE<<<

    'Modulnamen 
    For Each VBComp In VBProj.VBComponents
        'If Not VBComp.Name Like "*pdate*" Then
            If VBComp.Type = vbext_ct_StdModule Then
                VBComp.Name = VBComp.Name & "_"
            End If
        'End If
    Next VBComp

   'CodeKomponenten importieren
       For Each objDatei In fsoOrdner.Files
           For Each VBComp In VBProj.VBComponents
               If VBComp.Name = Left(objDatei.Name, Len(objDatei.Name) - 4) And Not (VBComp.Name Like "mod*pdate*" Or VBComp.Name Like "mod*UDF*") Then
                   Set fsoTextDatei = fso.OpenTextFile(objDatei.Path, ForReading, False)
                   Set CodeMod = VBComp.CodeModule
                   If objDatei.Name Like "*txt" Then
                       With fsoTextDatei
                           strCodeMod = .ReadAll
                           .Close
                       End With
                      With CodeMod
                           .DeleteLines 1, .CountOfLines
                           .InsertLines 1, strCodeMod
                     End With
                 ElseIf objDatei.Name Like "*bas" Then
                      If Not objDatei.Name Like "*pdate*" Then
                    With VBProj.VBComponents
                        .Remove VBComp
                        .Import Filename:=objDatei.Path
                    End With
                Else
                    strUpdateModul = objDatei.Name
                End If
            End If
        Next VBComp
    Next objDatei
   
    'Codeversion in Dokumentkommentare schreiben
    ThisWorkbook.BuiltinDocumentProperties("comments").Value = strCodeVersion
   
    'Projekt kompilieren Status setzten
    wsHelfer.Range("B19") = 0


End Sub