Aulesen aus geschlossenen Dateien

Forumthread: Aulesen aus geschlossenen Dateien

04.08.2006 14:56:09

Dirk

Hallo Ihr Excel-Meister !
Stehe vor einer kleinen Herausvorderung, die da wäre .... :
Mit diesem Script habe ich in einem Dokument immer daten aus der 2.Zeile des Sheets "Eingabe" in das "datensheet" übergeben (also immer unterhalb des letzten Eintrages).
Ich möchte nun aus sämmtlichen geschlossenen (*.xls) des Ordners "H:\Ergebnisse\" die 2. Zeile der "Tabelle1" an mein "Datensheet" importieren (kopieren und in mein aktuelles Datenblatt einfügen).
Ich habe hier auch in der Recherche einiges üner die Suche "Geschlossene" gefunden.
Aber dennoch komme ich nicht weiter.
Sitze nun 3 Tage daran :-( ... nun möchte Ich euch Spezialisten doch um Hilfe bitten !
Denke ist doch ein klax für euch oder ?
Also ich habe folgendes:


Sub Übergabe()
Rows("2:2").Select
Application.CutCopyMode = False
Selection.Copy
'Ab hier geht es ja los mit der Übergabe
Sheets("Daten").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.Save
End Sub

Möchte mich schon jetzt für eure tatkräftige Unterstützung bedanken !
("VBA gut" ist bei mir ne deffinitionssache - ich bemühe mich meine kenntnisse zu erweitern)
Gruß
Dirk

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Aulesen aus geschlossenen Dateien

04.08.2006 20:02:24

Josef

Hallo Dirk!
Wenn der Tabellenaufbau passt, dann sollte das hier klappen.

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public Sub ReadFromFile_ADO()
Dim objFS As FileSearch
Dim strPath As String
Dim intIndex As Integer, intC As Integer
Dim varValues As Variant
Dim lngNext As Long

On Error GoTo ErrExit

GetMoreSpeed

lngNext = Sheets("Daten").Cells(Rows.Count, 1).End(xlUp).Row + 1

If lngNext < 2 Then lngNext = 2

strPath = "H:\Ergebnisse" 'Verzeichnis

Set objFS = Application.FileSearch

With objFS
  .NewSearch
  .LookIn = strPath
  .FileType = msoFileTypeExcelWorkbooks
  .SearchSubFolders = False

  If .Execute > 0 Then

    For intIndex = 1 To .FoundFiles.Count

      With ExcelTable(.FoundFiles(intIndex), "Tabelle1", "A1:IV2")
        varValues = .GetRows
        .Close
      End With

      For intC = 0 To UBound(varValues)
        If IsNull(varValues(intC, 0)) Then varValues(intC, 0) = ""
      Next

      With Sheets("Daten")
        .Range(.Cells(lngNext, 1), .Cells(lngNext, UBound(varValues) + 1)) = Application.Transpose(varValues)
      End With

      lngNext = lngNext + 1

    Next

  End If

End With

ErrExit:

If Err Then
  MsgBox Err.Description & vbLf & Err.Number, 64, "Fehler"
  Err.Clear
End If

GetMoreSpeed 0

Set objFS = Nothing

End Sub

Public Function ExcelTable(ByRef Path As String, ByRef Table As String, ByRef SourceRange As String) As Object
Dim SQL As String
Dim Con As String
On Error Resume Next
SQL = "select * from [" & Table & "$" & SourceRange & "]"
Con = "Provider=Microsoft.Jet.OLEDB.4.0;" _
  & "Extended Properties=Excel 8.0;" _
  & "Data Source=" & Path & ";"
Set ExcelTable = CreateObject("ADODB.Recordset")
ExcelTable.Open SQL, Con, 1, 3
End Function

Sub GetMoreSpeed(Optional ByVal Modus As Integer = 1)

With Application
  If Modus = 1 Then
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
    .Calculation = -4135
    .Cursor = xlWait
  Else
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
    .Calculation = -4105
    .Cursor = xlDefault
  End If
End With

End Sub

Gruß Sepp

AW: Aulesen aus geschlossenen Dateien

04.08.2006 22:02:36

Dirk

Hallo Sepp,
du bist mein Held !!!
Funktioniert echt Super !
Darf ich Dich vielleicht nochmal fordern ?
Wenn ja ... kann man auch eine Vergleichfunktion da einarbeiten ?
Also wenn in z.B. Spalte "A" ein Wert (Name) schon vorhanden ist, dass diese Datei in dem der "Name" steht dann nicht nochmal eingelesen wird ?
Ich hoffe es ist jetzt nicht zu unverschämt !?
Was Du mir da gepostet hast ist jedenfalls echt mächtig, dass hätte ich so nie auf die Reihe bekommen.
Wenn das mit dem Vergleich nicht geht, hast du mir auch so schon megamäßig geholfen.
Einen riesen Dank dafür !!!
Gruß
Dirk

AW: Aulesen aus geschlossenen Dateien

04.08.2006 22:20:19

Josef

Hallo Dirk!
Ersetze diese Prozedur, dann sollte dein Wunsch erfüllt sein;-)

Public Sub ReadFromFile_ADO()
Dim objFS As FileSearch
Dim strPath As String
Dim intIndex As Integer, intC As Integer
Dim varValues As Variant
Dim lngNext As Long
Dim rng As Range

On Error GoTo ErrExit

GetMoreSpeed

lngNext = Sheets("Daten").Cells(Rows.Count, 1).End(xlUp).Row + 1

If lngNext < 2 Then lngNext = 2

strPath = "H:\Ergebnisse" 'Verzeichnis

Set objFS = Application.FileSearch

With objFS
  .NewSearch
  .LookIn = strPath
  .FileType = msoFileTypeExcelWorkbooks
  .SearchSubFolders = False

  If .Execute > 0 Then

    For intIndex = 1 To .FoundFiles.Count

      With ExcelTable(.FoundFiles(intIndex), "Tabelle1", "A1:IV2")
        varValues = .GetRows
        .Close
      End With

      For intC = 0 To UBound(varValues)
        If IsNull(varValues(intC, 0)) Then varValues(intC, 0) = ""
      Next

      With Sheets("Daten")
        Set rng = .Range("A:A").Find(What:=varValues(0, 0), LookAt:=xlWhole)
        If rng Is Nothing Then
          .Range(.Cells(lngNext, 1), .Cells(lngNext, UBound(varValues) + 1)) _
            = Application.Transpose(varValues)
          lngNext = lngNext + 1
        End If
        Set rng = Nothing
      End With

    Next

  End If

End With

ErrExit:

If Err Then
  MsgBox Err.Description & vbLf & Err.Number, 64, "Fehler"
  Err.Clear
End If

GetMoreSpeed 0

Set objFS = Nothing

End Sub

Gruß Sepp

AW: Aulesen aus geschlossenen Dateien

04.08.2006 22:40:22

Dirk

Du bist echt der Hit SEPP !
Vielen vielen Dank !!!!!
Funktioniert echt SUPER !
Siehst mich begeistert !
Ich hätte nun "gefuscht" ;-) und beim öffnen der Mappe alle zeilen löschen lassen.
Nach Buttonklick hätte ich diesen dann deaktiviert und erst beim öffnen der mappe wieder aktiviert - aber so ist es natürlich wesentlich eleganter und echt Professionell !
Nochmals Danke !
Gruß Dirk

Beliebteste Forumthreads (12 Monate)

Aulesen aus geschlossenen Dateien

Forumthread: Aulesen aus geschlossenen Dateien

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread