Pop Up Unterdrücken
28.09.2006 17:08:07
volker
mit folgendem makro werden Dateien geöffnet, geprüft, geändert abgespeichert.
Passt alles!
Nun bekomm ich ab und an die Meldung
"Diese Datei enthält Verknüpfungen zu anderen Datenquellen"
Hier hätte ich gerne das makro so erweitert, dass immer automatisch
"nicht aktualisieren" gewählt wird.
Kann mir jemand helfen?
Danke Gruss volker
Sub BlätterLöschen()
'Dateien öffnen
Dim wks As Worksheet
Dim fs As FileSearch
Dim lRow As Long
Dim iCounter As Integer
'Application.ScreenUpdating= false
Application.DisplayAlerts = False
Set fs = Application.FileSearch
lRow = 3
'lRow = InputBox("Zeilen Nr. angeben")
With fs
.SearchSubFolders = True 'mit Unterordner wenn =True
.Filename = "*.xls"
.LookIn = Range("D1").Value
.Execute
For iCounter = 1 To .FoundFiles.Count
'Cells(lRow, 1).Value = .FoundFiles(iCounter)
If VBA.FileDateTime(.FoundFiles(iCounter)) < Now - 14 Then
lRow = lRow
Workbooks.Open .FoundFiles(iCounter)
'unbeschriebene Beschlaglisten löschen
For Each wks In ActiveWorkbook.Worksheets
With wks
Range("A2").Select
Select Case .Name
Case "Holzliste", "Zeiten", "Skizzen", "Laufkarte"
'do nothing
Case "BL Container"
If Application.WorksheetFunction.CountA(.Range("A7:A32")) < 1 Then
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End If
Case "BL Conside"
If Application.WorksheetFunction.CountA(.Range("A7:A15"), .Range("A38"), .Range("A40:A60")) < 1 Then
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End If
Case "BL Depona"
If Application.WorksheetFunction.CountA(.Range("A7:A15"), .Range("A40:A60")) < 1 Then
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End If
Case "BL K4"
If Application.WorksheetFunction.CountA(.Range("A7:A17"), .Range("A21:A31"), .Range("A38:A40"), .Range("A46:A62")) < 1 Then
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End If
Case "BL Kabinentrennwand"
If Application.WorksheetFunction.CountA(.Range("A7:A18"), .Range("A21:A26")) < 1 Then
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End If
Case "BL ComWagen"
If Application.WorksheetFunction.CountA(.Range("A8:A31"), .Range("A39:A62")) < 1 Then
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End If
Case Else
If Application.WorksheetFunction.CountA(.Range("A7:A31"), .Range("A39:A64")) < 1 Then
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End If
End Select
End With
Next wks
ActiveWorkbook.Close savechanges:=True
'Application.Wait Now + 5 / 86400
End If
Next iCounter
End With
'Application.ScreenUpdating=True
Application.DisplayAlerts = True
End Sub