Office: (Office 2013) Makro ändern auf Excel4Macro

Hallo Zusammen,
vor einiger Zeit hat ein Kollege von mir das unten stehende Makro geschrieben.
Hier werden Dateien geöffnet und Werte ausgelesen.
Leider werden die Dateien alle geöffnet und ausgelesen.

Nun habe ich gelesen das man mit Excel4Macro auch die geschlossene Datei auslesen kann.

Ist es möglich das man das Makro so umschreibt das die Dateien in geschlossenem Zustand ausgelesen werden ?

Code:

Option Explicit
Sub Auswertung()
   'Alle Dateien des gewählten Ordners werden geöffnet.
   'Bestimmte Tageswerte werden gesammelt und ausgegeben.
   Dim oFSO          As Object         'FileSystemObject
   Dim oFolder       As Object         'Folder-Objekt
   Dim oFile         As Object         'File-Objekt
   Dim ws            As Worksheet
   Dim Quelle        As Object         'Dict für alle Dateien
   Dim colAuswertung As Collection     'Coll für alle Arrays einer Datei
   Dim Daten         As Variant        'Array
   Dim Ecke          As Range          'Basiszelle eines Bereichs
   Dim Bereich       As Range          'Bearbeitungsbereich
   Dim Zelle         As Range          'Bearbeitungszelle
   Dim Datum         As Date
   Dim iZeile        As Long           'laufende Zahl
   Dim iSchicht      As Long           'laufende Zahl
   Dim i_Teil        As Long           'laufende Zahl
   Dim p_Teil        As Long           'laufende Zahl
   Dim Summe         As Double         'Summe der Zeiten
   Dim IstWert       As Variant
  
   Application.ScreenUpdating = False
  
   Set Quelle = CreateObject("Scripting.Dictionary")      'Dict bekommt für jede Datei eine Coll
   Datum = Worksheets("T (Produktionsbericht)").Range("B1")
  
   Set oFSO = CreateObject("Scripting.FileSystemObject")
   If Worksheets("Input").Range("I2") = "" Then Call Ordnerauswahl(Worksheets("Input").Range("I2"))
   Set oFolder = oFSO.GetFolder(Worksheets("Input").Range("I2"))
'   Debug.Print "Pfad:", oFolder.Path          'Ordnerpfad\Ordnername
'   Debug.Print "Anzahl Dateien:", oFolder.Files.Count
  
   'Alle Dateien im Folder werden in durchlaufen
   For Each oFile In oFolder.Files
'         Debug.Print "Datei:", oFile.Name    'Dateiname
        
      'Einzelne Datei wird geöffnet
      With Workbooks.Open(Filename:=oFile.Path, UpdateLinks:=0, ReadOnly:=True)
        
'         Debug.Print .Name
         'Blattname "täglicheEingaben" suchen
         For Each ws In .Sheets
             If ws.Name = "täglicheEingaben" Then Exit For
         Next ws
        
         If ws Is Nothing Then
        
            'Blattname "täglicheEingaben" existiert nicht
            MsgBox "Die Datei " & vbCr & vbCr & _
                  .Name & vbCr & vbCr & _
                  "wird nicht ausgewertet, weil das Blatt " & vbCr & vbCr & _
                  "täglicheEingaben" & vbCr & vbCr & _
                  "nicht vorhanden ist. "
         Else


            'Blattname "täglicheEingaben" existiert
            With ws
              
               'Datum wird gesucht
               For iZeile = 5 To 1055 Step 35
                  If .Range("C" & iZeile) = Datum Then Exit For
               Next iZeile
              
               If iZeile <= 1055 Then

                  'Auswertung der Teile
                  ReDim Daten(1 To 10, 1 To 4)
                  For iSchicht = 1 To 3
                     p_Teil = 0     'Einträge in p-Plan
                     For i_Teil = 1 To 5
                        IstWert = .Cells(iZeile + 2 + i_Teil * 3, 1 + 9 * iSchicht) 'Ist
                        If IstWert > 0 Then
                           p_Teil = p_Teil + 1
                           'Wenn IstWert existiert, für diesen Teil Teilenummer, Soll und Ist übertragen
                          
                           Daten(p_Teil + 0, iSchicht) = .Cells(iZeile + 1 + i_Teil * 3, 1)                 'Name
                           Daten(p_Teil + 3, iSchicht) = .Cells(iZeile + 1 + i_Teil * 3, 1 + 9 * iSchicht)  'Soll
                           Daten(p_Teil + 6, iSchicht) = IstWert                                            'Ist
                           If p_Teil = 3 Then Exit For      'maximal 3 Einträge in Daten möglich
                        End If
                     Next i_Teil
                     Daten(10, iSchicht) = .Cells(iZeile + 20, 1 + 9 * iSchicht) 'Anlagenauslastung

                  Next iSchicht
                  
                  'Nächster Tag, nur Frühschicht
                  p_Teil = 0     'Einträge in p-Plan
                  For i_Teil = 1 To 5
                     IstWert = .Cells(iZeile + 35 + 2 + i_Teil * 3, 3)  'Ist, Erste Stunde
                     If IstWert > 0 Then
                        p_Teil = p_Teil + 1
                        'Wenn IstWert existiert, für diesen Teil Teilenummer, Soll und Ist übertragen
                        
                        Daten(p_Teil + 0, 4) = .Cells(iZeile + 35 + 1 + i_Teil * 3, 1)                'Name
'                        Daten(p_Teil + 3, 4) = .Cells(iZeile + 35 + 1 + i_Teil * 3, 10)               'Soll
'                        Daten(p_Teil + 6, 4) = IstWert                                            'Ist
                        If p_Teil = 3 Then Exit For      'maximal 3 Einträge in Daten möglich
                     End If
                  Next i_Teil
                  Daten(10, 4) = .Cells(iZeile + 35 + 20, 10) 'Anlagenauslastung

                  Set colAuswertung = New Collection           'Sammlung der einzelnen Arrays aus der Quelle
                  colAuswertung.Add Daten, "Auslastung"        'Eintrag in Coll. colAuswertung
                  
                  'Auswertung der Stillstände
                  For iSchicht = 1 To 3
                     Daten = .Range(Cells(iZeile + 26, 9 * iSchicht - 6), Cells(iZeile + 33, 9 * iSchicht))
                     colAuswertung.Add Daten, "Schicht" & iSchicht     'Eintrag in Coll. colAuswertung
                  Next iSchicht
                  Quelle.Add .Range("I1").Text, colAuswertung
                  
               End If
            End With
         End If
         .Close savechanges:=False  'Datei wird geschlossen
      End With
   Next oFile
   Application.ScreenUpdating = True
  
  
   'Eintragung in Blatt Produktionsbericht
   Set Ecke = Worksheets("T (Produktionsbericht)").Range("A2")
   Do While Ecke <> ""

'Debug.Assert Ecke.Text <> "Chiron 12"
      ReDim Daten(1 To 10, 1 To 4)
      If Quelle.exists(Ecke.Text) Then Daten = Quelle(Ecke.Text)("Auslastung")
      Ecke.Offset(1, 1).Resize(UBound(Daten, 1), UBound(Daten, 2)) = Daten
      Set Ecke = Ecke.Offset(12)
   Loop


   'Eintragung in Blatt Input
   Set Ecke = Worksheets("Input").Range("A3")
   Do While Ecke <> ""
      
      'Durchlauf im Blatt Input, bis kein Eintrag mehr gefunden
      Set Bereich = Range(Ecke.Offset(1), Ecke.End(xlDown))
      If Quelle.exists(Ecke.Text) Then
         For iSchicht = 1 To 3
            
            'Für jede Schicht jeden gefragten Störgrund suchen
            Daten = Quelle(Ecke.Text)("Schicht" & iSchicht)
            For Each Zelle In Bereich.Offset(, 2 * iSchicht)
              
               Summe = 0
               If Zelle <> "" Then     'Nur suchen, wenn Suchbegriff Zelle existiert
                  
                  'Alle Störungszeiten des Störgrund Zelle summieren
                  'Spalte 1 durchsuchen: Ergebnis aus Spalte 3
                  For iZeile = 1 To UBound(Daten, 1)
                     If Zelle = Daten(iZeile, 1) Then Summe = Summe + Daten(iZeile, 3)
                  Next iZeile
                  
                  'Spalte 4 durchsuchen: Ergebnis aus Spalte 7
                  For iZeile = 1 To UBound(Daten, 1)
                     If Zelle = Daten(iZeile, 4) Then Summe = Summe + Daten(iZeile, 7)
                  Next iZeile
               End If
               Zelle.Offset(, 1) = IIf(Summe > 0, Summe, "")
            Next Zelle
         Next iSchicht
      Else
      
         'Keine Maschinendatei vorhanden
         Bereich.Offset(, 3) = ""      'Schicht 1 löschen
         Bereich.Offset(, 5) = ""      'Schicht 2 löschen
         Bereich.Offset(, 7) = ""      'Schicht 3 löschen
      End If
    
      Set Ecke = Ecke.End(xlDown).Offset(2)
      
   Loop
   ThisWorkbook.Save
   Range("B2").Select
   MsgBox "Aktualisierung beendet"
End Sub

 

Hi,

das stimmt so nicht ganz - es ginge nur, per VBA Bezugs-Formeln zu den betreffenden Zellen zu erstellen und so die Daten in die Zielmappe zu holen - aber das ist sehr kompliziert, zumal du die Daten auch noch mit Bedingung übernehmen willst.

Weshalb sollen die Dateien denn überhaupr geschlossen bleiben? Du kannst sie doch öffnen und musst sie nur nach dem Übertragen der Daten wieder schließen. Und wenn du an den Anfang deines Codes noch die Zeile Application.ScreenUpdating = False schreibst, wird die Bildschirmaktualisierung ausgeschaltet und niemand bemerkt, dass die Dateien geöffnet werden.
Nicht vergessen, am Ende mittels Application.ScreenUpdating = True die Bildschirmaktualisierung wieder einzuschalten.

---

 

Hallo,
mir kam in den Sinn das es durch das nicht öffnen etwas schneller gehen würde.
Aber wenn es sehr umständlich ist dann lasse ich es so.
Besten dank für Deinen Tipp.

 

Hallo,

auf die Arbeitsblattzelle einer "geschlossenen" Exceldatei kann man wie folgt (Musterbeispiel) zugreifen:
='C:\Office-Hilfe\[cdv_Kopieren.xlsm]kw4'!$A$2
Dabei muss man die Syntax des Zellzugriffes genau einhalten, die Formel enthält folgende Bestandteile:
C:\Office-Hilfe\ ist der Zugriffspfad
[cdv_Kopieren.xlsm] ist der Excel-Dateiname, wobei die eckigen Klammern um den Dateinamen Pflicht sind
kw4 ist der Arbeitsblattname
$A$2 ist die Arbeitsblattzelle
Ferner muss 'Pfad\[Dateiname]Arbeitsblatt' in Hochkommas gesetzt werden und natürlich das Ausrufezeichen zwischen Arbeitsblattname und Arbeitsblattzelle gesetzt werden (aber das müsste eh klar sein).

Ich habe vorhin von einer "geschlossenen" Exceldatei gesprochen. Das ist aber nur eine schlichte Täuschung, denn auf geschlossene Dateien kann auch Microsoft nicht zugreifen. Natürlich wird bei Verwendung dieser Formel die enthaltene Datei im Dateisystem gesucht, geöffnet, der Zellinhalt abgeholt und die Datei hinterher wieder geschlossen. Das erfolgt im Hintergrund und benötigt natürlich genauso Rechenzeit.

 

Hallo Anton,

danke für Deine Informationen.