PDA

Vollständige Version anzeigen : Excel Makro - Laufzeitfehler 445


yves65
04.04.2012, 13:59
Hallo miteinander

Ich habe folgendes Makro erstellt. Leider erscheint eine Fehlermeldung, wenn ich es starte.

Die Meldung lautet: Laufzeitfehler 445, Objekt unterstützt Aktion nicht"

Beim Debuggen ist folgende Zeile gelb eingefärbt:
With Application.FileSearch

Weiss jemand, was hier nicht klappt?


Vielen Dank für eine Antwort und schon mal schöne Ostergrüsse

Yves

Anbei der Code:





Sub Korrekturmakro()
'
'
Dim MySheet As Worksheet ' aktuelles Arbeitsblatt
Dim strPath As String ' Dateipfad zum Auslesen der Dateien
Dim strFile As String ' Quelldatei
Dim wkbInput, meins As Workbook ' Quell-Arbeitsmappe
Dim wksInput As Worksheet ' Quell-Registerblatt
Dim lngTargetRow As Long ' Zeilenzähler für die Bewertungsinformationen
Dim lRow As Long ' Schleifenzähler
Dim lCol As Long ' Schleifenzähler
Dim delta As Integer
Application.DisplayAlerts = False


delta = 0
Set MySheet = ActiveSheet
Set meins = ActiveWorkbook
strPath = ActiveWorkbook.Path & "/"

'Alle Dateien auslesen im aktuellen Ordner und in allen Unterordnern'

With Application.FileSearch
.LookIn = strPath
.NewSearch
.SearchSubFolders = True
.Filename = "*.*"
.Execute

intAnz = .FoundFiles.Count

For intI = 1 To intAnz

strFile = .FoundFiles(intI) 'Quelldatei

If InStr(1, strFile, "Korrekturmakro draft.xlsm") <> 0 Then
'-------------------------------------------------'
' Datei Korrekturmakro übergehen
'-------------------------------------------------'
Else
'-------------------------------------'
' Quelldatei öffnen
' und 1. Registerblatt auswählen
'-------------------------------------'
Set wkbInput = Application.Workbooks.Open(strFile)
Set wksInput = wkbInput.Worksheets("allg Verhalten")






'
ActiveWindow.DisplayWorkbookTabs = True
Sheets("allg Verhalten").Select
ActiveSheet.Unprotect "cheyenne20"
ActiveWindow.SmallScroll Down:=6
ActiveWindow.DisplayHeadings = True
ActiveWindow.SmallScroll Down:=0

Range("AB30").Select
Selection.ClearContents
Range("AB31").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=9
Range("AB38").Select
Selection.ClearContents
Range("AB39").Select
Selection.ClearContents
Range("AB40").Select
Selection.ClearContents
Range("AB41").Select
Selection.ClearContents

ActiveWindow.DisplayHeadings = False

ActiveWindow.LargeScroll ToRight:=-1
ActiveSheet.Protect "cheyenne20", _
DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingRows:=True
ActiveWindow.DisplayWorkbookTabs = False
ActiveWorkbook.Save

delta = delta + 1

'-------------------------------------'
' Datei schließen
'-------------------------------------'
wkbInput.Close
Set wkbInput = Nothing

End If

Next intI ' Nächsten Eintrag abrufen

End With


MsgBox "Abgeschlossen"


End Sub

mücke
04.04.2012, 14:16
Moin Yves

eine Lösung kann ich Dir nicht liefern, aber FileSearch wird nur bis Version 2003 unterstützt, schau mal hier (http://www.wer-weiss-was.de/app/faqs/1245/3267)

yves65
05.04.2012, 09:10
Vielen Dank! Und auch danke an Microsoft, dass funktionierende Dinge einfach kaputt gemacht werden.
Kann mir jemand helfen, meinen Code so zu korrigieren, dass er funktioniert? Ich habe nur ganz wenig Programmierkenntnisse.

Herzlichen Dank

Terrance
19.03.2014, 14:41
Hallo,
habe das gleiche Problem. Würde gern regelmäßig mehrere Datenblätter aus unterschiedlichen Mappen zusammenfügen und dabei so wenige Finger wie möglich krumm machen. Habe mir dazu ein AddIn aus einem anderem Forum heruntergeladen (offenbar mit VBA programmiert) und bekomme jedes Mal die Fehlermeldung "Laufzeitfehler '445'". Die Schaltfläche 'Debuggen' ist ausgegraut.
Any ideas?

Viele Grüße