Alle Dateien eines Ordners - UserForm austauschen...

In allen Dateien eines Ordners (ohne Unterordner) eine geänderte UserForm importieren.

In all files of a folder (without subfolder) import a changed UserForm.

Hier noch eine Beispieldatei / Here's a sample file:
Alle Dateien eines Ordners - UserForm austauschen...[ZIP 250 KB]

Option Explicit
'--------------------------------------------------------------------------
' Module    : Modul1
' Procedure : Main
' Author    : Case (Ralf Stolzenburg)
' Date      : 20.02.2017
' Purpose   : Alle Dateien eines Ordners - UsrForm austauschen...
'--------------------------------------------------------------------------
Sub Main()
    ' Name der Ex- bzw. Importdatei
    Const strTMP As String = "uf.frm"
    Dim strFileName As String
    Dim strPath As String
    ' Wenn ein Fehler auftritt gehe zu der angegebenen Sprungmarke
    On Error GoTo Fin
    ' Bildschirmaktualisierung ausschalten
    Application.ScreenUpdating = False
    ' Pfad anpassen!!! Im Moment der Pfad mit der Datei mit diesem Makro
    strPath = ThisWorkbook.Path
    ' Letzten Backslash vergessen
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
    ' Datei schon/noch da, dann löschen
    If Dir$(Environ$("TEMP") & "\" & strTMP) <> "" Then
        Kill Environ$("TEMP") & "\" & strTMP
    End If
    ' UserForm aus DIESER Datei EXportieren - in TEMP-Ordner
    Workbooks(ThisWorkbook.Name).VBProject.VBComponents("UserForm1").Export Environ$("TEMP") & "\" & strTMP
    ' Erste Datei im Ordner suchen
    strFileName = Dir$(strPath & "*.xls*")
    ' Schleife über alle Dateien - OHNE Unterordner
    Do While strFileName <> ""
        ' DIESE Datei wird nicht berücksichtigt
        If Not strFileName = ThisWorkbook.Name Then
            ' Datei öffnen
            Workbooks.Open strPath & strFileName
            ' Der Code bezieht sich auf ein bestimmtes Objekt
            ' Hier die eben geöffnete Datei
            ' Alles was sich auf dieses "With" bezieht
            ' MUSS mit einem Punkt beginnen
            With Workbooks(strFileName)
                ' Alte UserForm löschen
                .VBProject.VBComponents.Remove .VBProject.VBComponents("UserForm1")
                ' Neue Userform IMportieren
                .VBProject.VBComponents.Import Environ$("TEMP") & "\" & strTMP
                ' Datei schliessen UND speichern
                .Close True
            End With
        End If
        ' Nächste Datei
        strFileName = Dir$()
    Loop
Fin:
    ' Datei schon/noch da, dann löschen
    If Dir$(Environ$("TEMP") & "\" & strTMP) <> "" Then
        Kill Environ$("TEMP") & "\" & strTMP
    End If
    ' Bildschirmaktualisierung einschalten
    Application.ScreenUpdating = True
    ' Wenn ein Fehler auftritt gib ihn aus mit Fehlernummer und Beschreibung
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub

Kommentare

Beliebte Posts aus diesem Blog

Formeln - auch Array - per VBA eintragen...

Alle Dateien eines Ordners - Optional mit Unterordner

Excel -> Word in Textmarken (Bookmarks)...