Makros aus vielen Tabellen entfernen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Makros aus vielen Tabellen entfernen
von: Chrischan
Geschrieben am: 08.10.2015 17:22:24

Hallo miteinander,
Ich möchte gerne aus vielen *xlsm Dateien die Makros löschen. (und ein Tabellenblatt ausblenden, wobei der Teil dann einfach sein sollte) Dazu gibt es eine "Masterdatei", in welcher ein Makro gestartet wird, von wo aus dann die anderen Tabellen geöffnet, bearbeitet und danach wieder abgespeichert und geschlossen werden sollen.
In diesem Forum hier hatte ich bereits eine ähnliche Fragestellung gefunden und versucht diese anzuwenden. Jedoch leider ohne Erfolg. (https://www.herber.de/forum/archiv/1044to1048/1046434_Makros_in_mehreren_Dateien_ausfuehren.html)
Aktuell scheitert es daran, dass ich die Meldung bekomme, dass die Funktion Worbooks.Open fehlschlägt. Ich habe auch schon danach gesucht, jedoch habe ich keine Lösung gefunden. (falscher Pfad oder ähnliches) Ich verstehe leider auch die Behandlung der Objekt Geschichten zu wenig um da alleine weiter voranzukommen.
Ich hoffe, dass mir jemand helfen kann. Ich habe das Gefühl, dass das Problem relativ trivial ist, ich allerdings nicht darauf komme.
Vielen Dank bereits im Voraus.
Der verwendete Code:


  **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub AnwendungMakrosVerzeichnis()
    Dim strInitialPath As String, strpath As String
    Dim objWB As Workbook
    Dim objFSO As Object
    Dim objFSODirectory As Object 'Verzeichniss-Objekt anlegen
    Dim objFSOFile As Object 'Datei-Objekt anlegen
    
    On Error GoTo ErrExit
    GMS
    
    strInitialPath = "C:\" 'Root-Verzeichnis zur Verzeichnisauswahl
    
    strpath = fncBrowseForFolder(strInitialPath)
    
    If strpath = "" Then GoTo ErrExit
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    'Das Verzeichniss-Objekt mit dem Verzeichniss
    'der geöffneten objFSOFile zuweisen:
    
    Set objFSODirectory = objFSO.GetFolder(strpath)
    
    'Nun alle Dateien in dem Ordner durchgehen
    For Each objFSOFile In objFSODirectory.Files
        
        'Wenn es eine Excel objFSOFile ist
        If UCase(Right(objFSOFile.Name, 3)) = "XLS" Then
            
            'Wenn die objFSOFile noch nicht geoeffnet ist oeffnen
            If Not WorkbookIsOpen(objFSOFile.Name) Then
                Set objWB = Workbooks.Open(objFSOFile.Path)
            Else
                Set objWB = Workbooks(objFSOFile.Name)
            End If
            
            objWB.Activate
            
            'hier nun das Makro aufrufen
            Call HideBlatt
            'Call DeleteMakros
           
            'eventuell die objFSOFile speichern und schliessen
            objWB.Close True
            Set objWB = Nothing
        End If
        
    Next
    ErrExit:
    If Err.Number <> 0 Then MsgBox "Fehler: " & Err.Number & vbLf & vbLf & _
        "Beschreibung: " & Err.Description, vbExclamation, "Fehler"
    
    GMS True
    Set objFSO = Nothing
    Set objFSOFile = Nothing
    Set objFSODirectory = Nothing
    Set objWB = Nothing
End Sub
Private Function fncBrowseForFolder(Optional ByVal defaultPath = "") As String
    Dim objFlderItem As Object, objShell As Object, objFlder As Object
    
    Set objShell = CreateObject("Shell.Application")
    Set objFlder = objShell.BrowseForFolder(0&, "Ordner auswählen...", 0&, defaultPath)
    
    If objFlder Is Nothing Then GoTo ErrExit
    
    Set objFlderItem = objFlder.Self
    fncBrowseForFolder = objFlderItem.Path
    
    ErrExit:
    
    Set objShell = Nothing
    Set objFlder = Nothing
    Set objFlderItem = Nothing
End Function
'Pruefung ob die objFSOFile schon in Excel geoeffnet ist
Function WorkbookIsOpen( _
        ByVal WorkbName As String _
        ) As Boolean
    
    Dim objWB As Workbook
    
    For Each objWB In Workbooks
        If objWB.Name = WorkbName Then
            WorkbookIsOpen = True
            Exit Function
        End If
    Next
    
End Function
Private Sub GMS(Optional ByVal Modus As Boolean = False)
    Static lngCalc As Long
    
    With Application
        .ScreenUpdating = Modus
        .EnableEvents = Modus
        .DisplayAlerts = Modus
        .EnableCancelKey = IIf(Modus, 1, 0)
        If Not Modus Then lngCalc = .Calculation
        .Calculation = IIf(Modus, lngCalc, -4135)
        .Cursor = IIf(Modus, -4143, 2)
    End With
    
End Sub
Sub HideBlatt()
    Application.DisplayAlerts = False
    ActiveWorkbook.Sheets(4).Visible = False
    Application.DisplayAlerts = True
End Sub

Bild

Betrifft: AW: Makros aus vielen Tabellen entfernen
von: Daniel
Geschrieben am: 08.10.2015 17:33:18
Hi
Set objWB = Workbooks.Open(objFSOFile.Path)
da müsste doch Pfad UND Dateiname stehen denn nur den Pfad alleine kannst du nicht öffnen.
Gruß Daniel

Bild

Betrifft: AW: Makros aus vielen Tabellen entfernen
von: Chrischan
Geschrieben am: 09.10.2015 08:39:21
Hallo und danke für deine Hilfe.
Deine Anmerkung klingt erstmal logisch. Ich habe nun das Path durch Name ersetzt. Dann habe ich nur den Fehler bekommen, dass die erste Datei in meinem Ordner (Dateiname komplett in der Fehlermeldung vorhanden) nicht gefunden werden konnte.
mit ObjFSOFile.Path.Name kommt der Fehler 424: Objekt erforderlch. Wenn ich mit Einzelschritten gehe kommt der Fehler definitiv beim Öffnen des Workbooks.
Wieso muss eigentlich überhaupt der Pfad angegeben werden? Eigentlich müssten doch alle Dateien in dem Objekt FSODirectory, bzw. je Durchlauf dann direkt im Objekt FSOFile befinden, oder nicht?!
Dazu eine Frage zu folgender Zeile:

If UCase(Right(objFSOFile.Name, 3)) = "xls" Then

Ich brauche ja XLSM ... kann ich das XLS einfach durch XLSM ersetzen? Wofür steht die 3 in der Klammer. Aktuell habe ich es etwas umständlich gelöst:
If Not UCase(Right(objFSOFile.Name, 3)) = "pdf" Then
Da PDF's die einzigen anderen Dateitypen in dem entsprechenden Ordner sind.
Kann der Fehler außerdem daran liegen, dass ich XLSM öffnen möchte und nicht XLS?

Bild

Betrifft: AW: Makros aus vielen Tabellen entfernen
von: Tino
Geschrieben am: 09.10.2015 10:57:14
Hallo,
kannst mal die Variante testen.
zuerst wird nach einen Ordner gefragt
aus diesen werden alle XLSM Dateien geöffnet u. als XLSX gespeichert
dadurch werden alle Makros entfernt.
Danach wird diese wieder als XLSM gespeichert
zugleich wird die 4. Tabelle ausgeblendet.
Bitte erst ausgiebig testen!!!
https://www.herber.de/bbs/user/100677.xlsm
Gruß Tino

Bild

Betrifft: AW: Makros aus vielen Tabellen entfernen
von: Chrischan
Geschrieben am: 09.10.2015 12:56:01
wow, das wäre genau die Lösung, die ich suche!
Leider schlägt die Ausführung wieder bei Workbooks.open fehl !?
Ich habe zum Testen extra einen seperaten Ordner angelegt mit nur XLSM files drin.
Vielen Dank für deine Mühe!

Bild

Betrifft: AW: Makros aus vielen Tabellen entfernen
von: Tino
Geschrieben am: 10.10.2015 10:06:18
Hallo,
kannst Du mal eine Datei hochladen wo dieser Fehler entsteht?
Habe es gerade eben an einigen Dateien getestet aber ein Fehler entsteht nicht!
Gruß Tino

Bild

Betrifft: AW: Makros aus vielen Tabellen entfernen
von: Chrischan
Geschrieben am: 10.10.2015 13:06:29
Hallo,
theoretisch ist das nicht optimal, aber da ich es leider aktuell nicht selber hinbekomme...
Ich hab die Tabelle mal etwas "bereinigt" die Makros etc. sind natürlich noch drin und das Arbeitsblatt 4, welches gelöscht werden soll.
Oh .. Die Datei ist knapp 4MB groß und kann deshalb nicht hier hochgeladen werden. Kann ich dir die evtl. direkt via Mail schicken? Als *.rar gepackt sind es noch ca. 600kb.

Bild

Betrifft: AW: Makros aus vielen Tabellen entfernen
von: Tino
Geschrieben am: 10.10.2015 13:23:48
Hallo,
kannst du die Datei nicht soweit abspecken das der Fehler bestehen bleibt?
Bei mir habe ich es mit 30 Dateien getestet mit Autostart Code ohne Fehler!
Gruß Tino

Bild

Betrifft: AW: Makros aus vielen Tabellen entfernen
von: Chrischan
Geschrieben am: 10.10.2015 13:58:22
Ok, jetzt verstehe ich gar nichts mehr.
Ich habe ein paar der Dateien in einen neuen Ordner kopiert und diesen beim nächsten Test ausgewählt. Da ist es auf einmal ohne Fehler durchgelaufen!
Das einzige was mich jetzt noch überrascht hat ist, dass am Ende nun doch wieder eine xlsm abgespeichert wird (richtigerweise ohne Makros). Die xlsx hätte völlig ausgereicht. Aber so ist es auch gut.
Die Datei habe ich völlig entleert und sogar 3 von 4 Makros gelöscht. Trotzdem wurde sie nicht kleiner als knapp 4MB.
Ich habe dein Makro jetzt auch einmal auf einen richtigen Ordner angewendet. Es hat gut funktioniert, wenn auch etwas langsam. Und leider kam nach ca. 10 Dateien wieder der Worbooks.Open Laufzeitfehler. In sofern wäre es vielleicht sogar besser, die Dateien als xlsx abzuspeichern, damit bei einem weiteren Durchlauf die Dateien nicht 2x bearbeitet werden müssen. Aber das schaffe ich vielleicht auch alleine.
Vielen Dank auf jeden Fall für deine Hilfe!!

Bild

Betrifft: AW: Makros aus vielen Tabellen entfernen
von: Tino
Geschrieben am: 10.10.2015 14:17:07
Hallo,
schade hätte mich schon mal interessiert warum mansche Dateien Probleme machen.
Dieser Code wandelt nur in XLSX um, den Verlauf kannst Du in der Statusleiste verfolgen!
Die Sub Start durch diese ersetzen.

Sub Start()
Dim sPathXLSM$, ArFiles, n&, nn&, nnn&
Dim FileXLSX$
Dim ArFehler()
Dim NewApp As Excel.Application

sPathXLSM = fncGetFolder("Ordner mit XSML Datei wählen!", ThisWorkbook.Path)
If sPathXLSM = "" Then Exit Sub
If Right$(sPathXLSM, 1) <> "\" Then sPathXLSM = sPathXLSM & "\"

ArFiles = FindFile(sPathXLSM, "*.xlsm")
If Not IsArray(ArFiles) Then Exit Sub

Set NewApp = New Excel.Application
With NewApp
    .ScreenUpdating = False
    .DisplayAlerts = False
    .EnableEvents = False
    
    nn = Ubound(ArFiles, 2)
    For n = Lbound(ArFiles, 2) To nn
        Application.StatusBar = "Bearbeite [Datei " & n & " von " & nn & "] " & ArFiles(2, n)
        FileXLSX = Left$(ArFiles(1, n), Len(ArFiles(1, n)) - 4) & "xlsx"
        With .Workbooks.Open(ArFiles(1, n))
            If Not .ReadOnly Then
                If .Sheets.Count > 3 Then .Sheets(4).Visible = False
                .SaveAs FileXLSX, xlOpenXMLWorkbook
                .Close False
                 DoEvents
                 Kill ArFiles(1, n)
            Else
                Redim Preserve ArFehler(nnn)
                ArFehler(nnn) = ArFiles(2, n)
                nnn = nnn + 1
                .Close False
            End If
        End With
    Next n
End With

On Error Resume Next

NewApp.Quit
Set NewApp = Nothing
Application.StatusBar = False
If nnn > 0 Then
    MsgBox "Diese Dateien waren Schreibgeschützt!" & vbCr & vbCr & _
            Join(ArFehler, vbCr), _
            vbExclamation, "Datei ohne Umwandlung!"
End If
End Sub
Gruß Tino

Bild

Betrifft: AW: Makros aus vielen Tabellen entfernen
von: Chrischan
Geschrieben am: 10.10.2015 14:26:28
Ich finde leider auch keine Erklärung, warum es manchmal nicht funktioniert. Grundsätzlich ist die Tabelle jedesmal identisch. Nur die Zahlenwerte ändern sich und der Dateiname ist minimal unterschiedlich. Es ist jedoch an einer bestimmten Datei passiert. Die habe ich nun manuell bearbeitet und kann den Rest weiter mit dem Makro bearbeiten. Seltsam.
Nochmal vielen vielen Dank für diese super Hilfe!

Bild

Betrifft: AW: Makros aus vielen Tabellen entfernen
von: Chrischan
Geschrieben am: 10.10.2015 14:17:55
Ok, jetzt verstehe ich gar nichts mehr.
Ich habe ein paar der Dateien in einen neuen Ordner kopiert und diesen beim nächsten Test ausgewählt. Da ist es auf einmal ohne Fehler durchgelaufen!
Das einzige was mich jetzt noch überrascht hat ist, dass am Ende nun doch wieder eine xlsm abgespeichert wird (richtigerweise ohne Makros). Die xlsx hätte völlig ausgereicht. Aber so ist es auch gut.
Die Datei habe ich völlig entleert und sogar 3 von 4 Makros gelöscht. Trotzdem wurde sie nicht kleiner als knapp 4MB.
Ich habe dein Makro jetzt auch einmal auf einen richtigen Ordner angewendet. Es hat gut funktioniert, wenn auch etwas langsam. Und leider kam nach ca. 10 Dateien wieder der Worbooks.Open Laufzeitfehler. In sofern wäre es vielleicht sogar besser, die Dateien als xlsx abzuspeichern, damit bei einem weiteren Durchlauf die Dateien nicht 2x bearbeitet werden müssen. Aber das schaffe ich vielleicht auch alleine.
Vielen Dank auf jeden Fall für deine Hilfe!!

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Makros aus vielen Tabellen entfernen"