---

Hallo liebe Leute

Ich habe das Forum nun gut 2h durchsucht und viele Probleme lösen können.
Nun stehe ich aber am Berg. Vorallem da ich kaum Ahnung von der Materie habe.

Das Ziel:
Makro soll in einem Ordner nach files suchen und diese einlesen.

Beim Debug kommt nun der Error bei folgendem Abschnitt.

ASF.NewSearch
  ASF.LookIn = strFilePath
  ASF.FileName = "*.xls"

  If ASF.Execute(SortBy:=msoSortByFileName, _
    SortOrder:=msoSortOrderAscending) > 0 Then
       
        'Zählen wieviele Dateien sich in dem Ordner befinden
        'MsgBox "There were " & ASF.FoundFiles.Count & _
          '" file(s) found."
        strFound = ASF.FoundFiles.Count
        MsgBox ("Es wurden" & strFound & " Dateien gefunden. Diese werden nun geöffnet und die relevanten Werte ausgelesen.")
       
        'Öffnen und Auslesen der einzelnen Dateien
        For i = 1 To ASF.FoundFiles.Count
            strFileName = ASF.FoundFiles(i)
            Workbooks.Open ASF.FoundFiles(i)
            Length = Len(strFileName)
            'MsgBox ("Die vorherige Datei wurde geschlossen. Nun wird folgende Datei geöffnet: " & strFileName)
           
            'Auslesen des .xls filenamens
            For o = 1 To Length
                If Mid(strFileName, Length - o, 1) = "\" Then
                    ShortFileName = Right(strFileName, o)
                    Exit For
                End If
            Next o
                                   
            If Workbooks("Auswertung.xls").Sheets("Menü").Cells(11, 5).Value = "Ja" Then
                Workbooks(ShortFileName).Sheets("Eingabe").Cells(4, 9).Value = Workbooks("Auswertung.xls").Sheets("Menü").Cells(12, 5).Value
                Workbooks(ShortFileName).Sheets("Eingabe").Cells(5, 9).Value = Workbooks("Auswertung.xls").Sheets("Menü").Cells(13, 5).Value
            End If
                                   
            'Einkopieren der relevanten Einträge über die Mappingtabelle
            For p = 2 To MappingEnde
                SourceActualColumn = Workbooks("Auswertung.xls").Sheets("MappingAuslesenLG").Cells(p, 2).Value
                SourceActualRow = Workbooks("Auswertung.xls").Sheets("MappingAuslesenLG").Cells(p, 1).Value
                GoalActualColumn = Workbooks("Auswertung.xls").Sheets("MappingAuslesenLG").Cells(p, 3).Value
                Workbooks("Auswertung.xls").Sheets("AuswertungLG").Cells(StartTabelle, GoalActualColumn) = Workbooks(ShortFileName).Sheets("Eingabe").Cells(SourceActualRow, SourceActualColumn).Value
            Next p

          StartTabelle = StartTabelle + 1
          Workbooks(ShortFileName).Close SaveChanges:=False
         
          Next i
                                     
    Else
        MsgBox "There were no files found."
    End If

End Sub

Diese Makros wurden für uns mal erstellt und nie gewartet und nun da wir Office 2010 haben läuft es nicht mehr.
gibt es hier einen easy work around?

Besten Dank für die Zeit

Alvi

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Alvi,

was für ein Fehler kommt denn wo? Bist du mal Schritt für Schritt durchgegangen?

------------------
MFG
Rick Schulz

Nettiquette (CAD.de)  -  Was ist die Systeminfo?  -  Wie man Fragen richtig stellt.  -  Unities

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo alvi,

und herzlich willkommen im SolidWorksbrett auf CAD.de 

Der Laufzeitfehler: '91' Objektvariable oder With Block nicht festgelegt bedeutet, dass die Variable (welche kannst nur du beantworten, der Debugger steht dann normalerweise in genau der Zeile) nicht definiert ist, sprich, sie hat keinen Inhalt und ist Nothing. Da ist vermutlich durch die Umstellung auf VBA7 in Office 2010 etwas anders als vorher.

Ich vermute, dass es etwas mit dem Objekt ASF zu tun hat, leider ist keine Deklaration oder so zu sehen. Vielleicht benutzt das Windows API Calls, die müssen ggf. anders deklariert werden, siehe http://msdn.microsoft.com/de-de/library/office/ee691831(v=office.14).aspx

Vielleicht hilft das schon weiter.

Ciao,
Stefan

------------------
Inoffizielle deutsche SolidWorks Hilfeseite    http://solidworks.cad.de

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Stefan

das ging ja fix mit der Antwort. Leider hatte ich lange Zeit mehr für das Thema.
Mir scheint, dass er ASF.Newsearch nicht versteht.
gibt es denn dafür einen neuen code?
so wie ich das verstehe, muss dieser Befehl einfach eine Suche auslösen, die dann weiter unter noch deffiniert wird.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

hier noch der obere Teil zum Thema ASF:

'Kreieren von ASF Objekt
  Dim ASF As Object
 
  'Öffnen der Dateien durchscannen dieser
  'Initialisieren des Objektes und suchen nach .xls Dateien
  strFilePath = Workbooks("Auswertung.xls").Sheets("Menü").Cells(14, 5).Value

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo alvi,

so wie du es hier gepostet hast kann das nie gelaufen sein.

mit

Code:

---

'Kreieren von ASF Objekt
  Dim ASF As Object

---

wird zwar ein Objekt deklariert, jedoch nicht kreiert. Das im Kommentar zu behaupten reicht leider nicht 
vor der ersten Nutzung, also warscheinlich ASF.NewSearch erstellt werden.

es muß eine Zuweisung nach dem Muster

Code:

---

SET ASF = CreateObject(.........)

---

oder auch

Code:

---

Set ASF = New ...

---

geben.

Dann sieht man auch von welchen Typ dieses Objekt ist und kann dann ermitteln ob es eine Methode 'NewSearch' besitzt.

Gruß
Peter

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

oho! macht sinn!
bedanke mich für den Hinweis und werde es demnächst testen.

danke schön an alle Ratschläge soweit!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Peter

Danke für deine Zeit.

Nun bin ich aber wie erwähnt ein blutiger Anfänger.

Ich verstehe was du meinst. Befehlt Kreieren wird nicht ausgeführt.
DIM ASF ist nur eine definition.

Wie sollte den der Code aussehen, damit er im Explorer diese X-Anzahlfiles sucht und einliest?

Falls du nochmal Zeit hast, wäre ich froh um eine Anpassung wie du denkst, dass es funktionieren müsste.

Beste Grüsse

Alvi

Sub DEinlesenLG()

Dim LGPeriode As Date
Dim StartTabelle As Integer
Dim MappingEnde As Integer
Dim SourceActualColumn As Integer
Dim SourceActualRow As Integer
Dim GoalActualColumn As Integer
Dim Aufsummierung As Double

Dim strFilePath As String
Dim strFound As Variant
Dim strFileName As String
Dim ShortFileName As String
Dim strDate As String

' Variablen füllen
LGPeriode = Workbooks("Auswertung.xls").Sheets("Menü").Cells(12, 5).Value
StartTabelle = 7
MappingEnde = RowCount("MappingAuslesenLG", 1)

Sheets("AuswertungLG").Range("A2:FF60000").Delete
 
  'Kreieren von ASF Objekt
  Dim ASF As Object
 
 
  'Öffnen der Dateien durchscannen dieser
  'Initialisieren des Objektes und suchen nach .xls Dateien
  strFilePath = Workbooks("Auswertung.xls").Sheets("Menü").Cells(14, 5).Value
 
  ASF.NewSearch
  ASF.LookIn = strFilePath
  ASF.FileName = "*.xls"

  If ASF.Execute(SortBy:=msoSortByFileName, _
    SortOrder:=msoSortOrderAscending) > 0 Then
       
        'Zählen wieviele Dateien sich in dem Ordner befinden
        'MsgBox "There were " & ASF.FoundFiles.Count & _
          '" file(s) found."
        strFound = ASF.FoundFiles.Count
        MsgBox ("Es wurden" & strFound & " Dateien gefunden. Diese werden nun geöffnet und die relevanten Werte ausgelesen.")
       
        'Öffnen und Auslesen der einzelnen Dateien
        For i = 1 To ASF.FoundFiles.Count
            strFileName = ASF.FoundFiles(i)
            Workbooks.Open ASF.FoundFiles(i)
            Length = Len(strFileName)
            'MsgBox ("Die vorherige Datei wurde geschlossen. Nun wird folgende Datei geöffnet: " & strFileName)
           
            'Auslesen des .xls filenamens
            For o = 1 To Length
                If Mid(strFileName, Length - o, 1) = "\" Then
                    ShortFileName = Right(strFileName, o)
                    Exit For
                End If
            Next o
                                   
            If Workbooks("Auswertung.xls").Sheets("Menü").Cells(11, 5).Value = "Ja" Then
                Workbooks(ShortFileName).Sheets("Eingabe").Cells(4, 9).Value = Workbooks("Auswertung.xls").Sheets("Menü").Cells(12, 5).Value
                Workbooks(ShortFileName).Sheets("Eingabe").Cells(5, 9).Value = Workbooks("Auswertung.xls").Sheets("Menü").Cells(13, 5).Value
            End If
                                   
            'Einkopieren der relevanten Einträge über die Mappingtabelle
            For p = 2 To MappingEnde
                SourceActualColumn = Workbooks("Auswertung.xls").Sheets("MappingAuslesenLG").Cells(p, 2).Value
                SourceActualRow = Workbooks("Auswertung.xls").Sheets("MappingAuslesenLG").Cells(p, 1).Value
                GoalActualColumn = Workbooks("Auswertung.xls").Sheets("MappingAuslesenLG").Cells(p, 3).Value
                Workbooks("Auswertung.xls").Sheets("AuswertungLG").Cells(StartTabelle, GoalActualColumn) = Workbooks(ShortFileName).Sheets("Eingabe").Cells(SourceActualRow, SourceActualColumn).Value
            Next p

          StartTabelle = StartTabelle + 1
          Workbooks(ShortFileName).Close SaveChanges:=False
         
          Next i
                                     
    Else
        MsgBox "There were no files found."
    End If

End Sub

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Servus
Probiere es mal mit

Code:

---

Set ASF = Application.FileSearch

---

siehe auch hier.

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

na da brat mir doch einer nen storch!
habe es mal so gemacht:

  ASF.NewSearch
  ASF.LookIn = strFilePath
  ASF.FileName = "*.xls"

und nun ist der laufzeitfehler weg! freide herrscht im ganzen land

aber er meint nun, dass er keine files findet. Werde mal schauen was da los ist, denn die files sind hier.

aber besten dank für die Zeit und Geduld soweit

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,

in 2010 gibt es das FileSearch-Objekt nicht mehr. Da du nur auf einer Ebene (ohne Unterordner) suchst kannst du das Ganze mit der Dir-Funktion ersetzen.

------------------
Gruß
Nepumuk 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

ich verstehe!
okay... aber wie funktioniert diese "dir" funktion :-)
wie müssten denn dann dieser befehl lauten gemäss meiner Formel oben?

es ist ein drama ;-)

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,

ein Beispiel:

Code:

---

Public Sub Beispiel()
   
    Dim strPath As String, strFilename As String
   
    strPath = Workbooks("Auswertung.xls").Sheets("Menü").Cells(14, 5).Value
   
    If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"
   
    strFilename = Dir$(strPath & "*.xls")
   
    Do Until strFilename = vbNullString
   
   
        MsgBox strPath & strFilename ' Nur zum Testen
       
       
        strFilename = Dir$
   
    Loop
End Sub

---

Kennst du übrigens die Hilfefunktion von Excel? Da ist alles beschrieben.

------------------
Gruß
Nepumuk 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Das geht ja hier schlag auf schlag.

danke für den tipp! werde es heute nachmittag mal testen!

hilfefunktion? macht sinn :-) versuch ich dann auch mal.

merci soweit!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP