HERBERS Excel-Forum - das Archiv
Bewerten Sie hier bitte das Excel-Portal
Arbeitsblätter Öffnen Schleife
carstma

Guten Abend....
Habe folgende Mappen: LS00001.xls, LS00002.xls, LS00003 usw. 20000Stück
Jede datei beinhaltet die gleiche Struktur und ein gleiches Makro
Ziel: Möchte die Mappen nacheinander mit einer Schleife die 1. Datei öffnen, dann die Makros entfernen, an einer anderen Stelle unter gleichem Namen abspeichern, dann die 2. Öffnen usw. usw.
Kann mir jemand helfen, Ich finde nichts passsendes (bin nur Makrozusammenstückler...)
Vielen Dank im Voraus!!

AW: Arbeitsblätter Öffnen Schleife
Josef

Hallo Carsten,
20000 Dateien? Das kann aber dauern!
Teste den Code erstmal an ein paar Dateien.
' **********************************************************************
' Modul: Modul3 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub saveFilesWithoutCode()
  Dim objWB As Workbook
  Dim strPath As String, strNewPath As String, strFile As String
  
  On Error GoTo ErrExit
  GMS
  
  strPath = "E:\Temp\" 'Verzeichnis - Anpassen!
  
  strNewPath = "E:\Temp\Test" 'Speicherpfad - Anpassen!
  
  If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
  
  If Right(strNewPath, 1) <> "\" Then strNewPath = strNewPath & "\"
  
  strFile = Dir(strPath & "*.xls*", vbNormal)
  
  Do While strFile <> ""
    Set objWB = Workbooks.Open(strPath & strFile)
    deleteAllCodeAndModules objWB
    objWB.SaveAs strNewPath & strFile
    objWB.Close
    strFile = Dir
  Loop
  
  ErrExit:
  With Err
    If .Number <> 0 Then MsgBox "Fehler " & .Number & vbLf & vbLf & _
      .Description & vbLf & vbLf & "In Prozedur (saveFilesWithoutCode) in Modul Modul3", _
      vbExclamation, "Fehler in Modul3 / saveFilesWithoutCode"
  End With
  
  GMS True
  
  Set objWB = Nothing
End Sub

Sub deleteAllCodeAndModules(ByRef WBook As Workbook)
  Dim objVBComp As Object
  With WBook.VBProject
    For Each objVBComp In .vbcomponents
      If objVBComp.Type = 100 Then
        With .vbcomponents(objVBComp.Name).CodeModule
          .DeleteLines 1, .CountOfLines
        End With
      Else
        .vbcomponents.Remove objVBComp
      End If
    Next
  End With
End Sub

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
    If Modus And lngCalc = 0 Then lngCalc = -4105
    .Calculation = IIf(Modus, lngCalc, -4135)
    .Cursor = IIf(Modus, -4143, 2)
    
  End With
  
End Sub

Gruß Sepp

AW: Arbeitsblätter Öffnen Schleife
carstma

Hallo Sepp,
Danke, geht aber leider nicht kommt immer Fehlermeldung....
Gruß
Carsten
AW: Arbeitsblätter Öffnen Schleife
Josef

Hallo Carsten,
unter Extras > Makros > Sicherheit > Vertrauenswürdige Herausgeber, muss der Haken
bei "Zugriff auf Visual Basic-Projekt zulassen" gesetzt sein und die VBA-Projekte dürfen nicht
geschützt sein.
Gruß Sepp

AW: Arbeitsblätter Öffnen Schleife
carstma

Erstmal vielen Dank Sepp !!
Wenn man die Zeile
deleteAllCodeAndModules objWB "stilllegt"
dann kopiert das proggi die Dateien schön ins andere Verzeichnis aber natürlich mit Makro
ansonsten Absturz an der Stelle
Ich hab leider keine Idee
Weißt Du oder Ihr anderen noch was?
AW: Arbeitsblätter Öffnen Schleife
carstma

Faschmeldung Funktioniert wunderbar!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Allerdigs ist mein Makro mit einem Password geschützt....
Ist mir natürlich bekannt
Wie bekomme ich das raus in welche Schleife muß da noch was rein.... hoffendlich geht das?
Gruß Carsten
AW: Arbeitsblätter Öffnen Schleife
Josef

Hallo Carsten,
das geht nur mit "SendKeys" und da lass ich die Finger davon.
In der Recherche findest du aber sicher genügend Beispiele.
Gruß Sepp