Auslesen von Werten in ungeöffneten Dateien

[Hardbopper]

Hallo Community,

zum obigen Thema gibt es schon einige Beiträge, die aber alle nicht so recht passen (ich bin auch nicht der VBA-Experte, sie anzupassen). Deshalb bitte ich um Hilfe zu folgendem:

Das Verzeichnis Downloads enthält Excel-Dateien, aus denen bestimmte Werte, die immer in die Zellen B7 und D7 geschrieben sind, in ein Tabellenblatt eines anderen Ordners übertragen werden sollen, ohne dass die Quell-Dateien geöffnet werden. Das Verzeichnis Download ist geöffnet, ebenso die Ziel-Datei. Ich stelle mir den Ablauf so vor, dass die Quell-Datei markiert wird und anschließend ein Makro über die Ziel-Datei ausgelöst wird. Die zu übertragenden Werte können in den Spalten A und B landen, es ist nur zu beachten, dass bei einer Wiederholung des Vorgangs keine belegten Zellen überschrieben werden.

Ich bitte die Experten um Vorschläge.

Sollte ich bei der Beschreibung etwas übersehen haben: Bitte melden.

Hardbopper

[Steffl]

Hallo,

mal ein ungetesteter Ansatz

Code:

Option Explicit
'Makro zum Auflisten aller XL-Dateiene eines Verzeichnisses (ohne Unterverzeichnisse !)
'11.01.2013, NoNet - www.excelei.de

Sub GeschlosseneMappenListen()
    'Autor NoNet
    Dim fs As Object
    Dim fverz As Object
    Dim fDatei As Object
    Dim FDateien As Object
    Dim strOrdner As String
    Dim strTyp As String
    Dim lngZ As Long
    
    lngZ = Cells(Rows.Count, 1).End(xlUp).Row + 1
    strOrdner = "C:\Downloads\" 'Ordnername mit "\" am Ende ! Bitte anpassen!!!!!!!!!!!!!!!!
    Set fs = CreateObject("Scripting.Filesystemobject")
    Set fverz = fs.getfolder(strOrdner)
    Set FDateien = fverz.Files
    
    Application.EnableEvents = False 'keine Events ausführen !
    
    For Each fDatei In FDateien
        strTyp = Split(fDatei.Name, ".")(UBound(Split(fDatei.Name, ".")))
        If UCase(strTyp) Like "XL*" And InStr(fDatei.Type, "Excel") > 0 Then
            Cells(lngZ, 1).Value = GetDataClosedWB(strOrdner, fDatei.Name, fDatei.Worksheets(1).Name, "B7", Cells(lngZ, 1).Address)
            Cells(lngZ, 2).Value = GetDataClosedWB(strOrdner, fDatei.Name, fDatei.Worksheets(1).Name, "D7", Cells(lngZ, 2).Address)
            lngZ = lngZ + 1
        End If
    Next fDatei

    Application.EnableEvents = True 'Events wieder ausführen !
    
    MsgBox "Fertig !"
End Sub

Public Function GetDataClosedWB(SourcePath As String, _
    SourceFile As String, sourceSheet As String, _
        SourceRange As String, TargetRange As Range) As Boolean
    'Holt einen Bereich aus einer _geschlossenen_ Arbeitsmappe
    'Nur in VBA zu verwenden; nicht aus einer Tabellenzelle heraus
    '© t.ramel@mvps.org
    ' wird durch die HoleDaten aufgerufen
    Dim strQuelle       As String
    Dim Zeilen          As Long
    Dim Spalten         As Byte
    On Error GoTo InvalidInput
    strQuelle = "'" & SourcePath & "[" & SourceFile & "]" & sourceSheet & "'!" & Range( _
SourceRange).Cells(1, 1).Address(0, 0)
    Zeilen = Range(SourceRange).Rows.Count
    Spalten = Range(SourceRange).Columns.Count
    With TargetRange.Cells(1, 1).Resize(Zeilen, Spalten)
        .Formula = "=IF(" & strQuelle & "="""",""""," & strQuelle & ")"
        .Value = .Value
    End With
    GetDataClosedWB = True
    Exit Function
InvalidInput:
    MsgBox "Die Quelldatei oder der Quellbereich ist ungültig!", vbExclamation, "Get data from closed Workbook"
    GetDataClosedWB = False
End Function

[Hardbopper]

Hallo Stefan,

der Code funktioniert leider nicht: "Pfad nicht gefunden" und das, obwohl ich die Quelle (C:\Downloads\*csv) angepasst habe.

Nochmals zur Erläuterung: 

Die csv-Excel-Dateien sind in keinem Ordner zusammengefasst, sondern stehen unmittelbar im Verzeichnis Downloads. Vielleicht liegt es daran. Die auszulesenden Werte sollen in einem xlsm-Tabellenblatt abgespeichert werden.

Trotzdem Danke !!!

Hardbopper

[Zwergel]

Hi,
mach mal Punkt vor csv, also *.csv

[Steffl]

Hallo,

hast Du diese

Code:

If UCase(strTyp) Like "XL*" And InStr(fDatei.Type, "Excel") > 0 Then

Codezeile auch angepaßt?

[snb]

Code:

Sub M_snb()
   sn=split(createobject("wscript.shell").exec("cmd /c Dir C:\Downloads\*.csv").stdout.readall,vbcrlf)

  redim sp(ubound(sn),1)
  with createobject("scripting.filesystemobject")
    for j=0 to ubound(sn)-1
      st=split(split(.opentextfile("C:\Downloads\" & sn(j)).readall,vbcrlf)(6),";")
      sp(j,0)=st(1)
      sp(j,1)=st(3)
    next
  end with
  sheet1.cells(1).resize(ubound(sp),2)=sp
End Sub

[Hardbopper]

Dank Euch allen, es funktioniert leider nicht, ich habe mich deshalb zu einer Hilfslösung entschlossen: Ich öffne den Explorer über Excel ( Call Shell("Explorer /e, "& ThisWorkbook.Path, vbNormalFocus), habe damit beides nebeneinander stehen und kopiere die in Frage kommenden Werte.

Hardbopper

[schauan]

Hallöchen,

zwei Fragen wären da noch. Willst Du die Daten aus einzelnen Dateien oder soll die Lösung die Daten aller csv des Downloadverzeichnisses holen? Ist das Trennzeichen das Komma oder das Semikolon?

Auch wenn mein Vorschlag nicht ganz ohne Öffnen auskommt, so merkst Du jedenfalls nichts davon. Du musst zuerst eine csv auswählen und dann werden die Inhalte der zweiten und vierten "Spalte" aus Zeile 7 der csv in der Zieldatei in SPalte A und B eingetragen. Eine csv ist übrigens keine Exceldatei. Die wird nur auf Systemen mit Office unergründlicherweise mit einem Excelsymbol versehen ... Wenn bei Dir ein anderes Zeichen als ein Semikolon zum Trennen der "Spalten" genommen wird, müsstest Du die beiden Stellen im code ändern.

Code:

Option Explicit

Sub CSV_EinLesen()
'Variablendeklarationen
'Variant
Dim varFileName, arrLines
'Zeichenkette
Dim strLines$
'Datei waehlen
varFileName = Application.GetOpenFilename("CSV-Dateien,*.csv,Alle Dateien,*.*", , "Datei öffnen")
'Wenn nichts gewaehlt wurde, dann Makro verlassen
If varFileName = False Then Exit Sub
'alle Zeilen als eine Zeichenkette einlesen
strLines = ReadFile(CStr(varFileName))
'Zeilen trennen
arrLines = Split(strLines, Chr(10))
'Daten uebertragen
'mit der letzten ausgefuellten Zelle in Spalte A
With Cells(Rows.Count, 1).End(xlUp)
 'darunter Wert aus 2. Spalte eintragen - Trennzeichen ";"
 .Offset(1, 0) = Split(arrLines(7), ";")(1)
 'darunter daneben Wert aus 4. Spalte eintragen - Trennzeichen ";"
 .Offset(1, 1) = Split(arrLines(7), ";")(3)
'Ende mit der letzten ausgefuellten Zelle in Spalte A
End With
End Sub

Private Function ReadFile(ByVal strFileName As String) As String
'Variablendeklarationen
'Integer, String
Dim iFile%, strAll$
'Freie Dateinummer zuweisen
iFile = FreeFile
'Datei binär öffnen
Open strFileName For Binary As #iFile
'Datei komplett einlesen
strAll = Space(LOF(iFile)): Get #iFile, , strAll
'Datei schliessen
Close #iFile
'Zeichenkette zurueckgeben
ReadFile = strAll
End Function

[Hardbopper]

Hallo schauan ( mein Helfer in der Not ist wieder am Werk) ,

ich habe das Makro eingesetzt, werde aufgefordert, die in Frage kommende Datei zu öffnen und erhalte, nachdem ich das getan habe, 

1. den Eintrag in der Zielliste: "keine" 

2. die Fehlermeldung: Laufzeitfehler '9' : Index außerhalb des gültigen Bereichs

Kann das daran liegen, dass die in Betracht kommenden Dateien im Verzeichnis "Downloads" liegen ?

Gruß Hardbopper

[Hardbopper]

Hallo schauan,

 Deine Bemerkung zum Charakter von CSV-Dateien hat mich auf die Idee gebracht, die ausgewählte Datei müsste zunächst konvertiert werden (Du siehst, ich lerne dazu).

Ich habe das versuchsweise getan (Datei - aus Text), dadurch passiert folgendes:

a) alle Werte der ursprünglichen Tabelle werden - durch Semikolon getrennt - in Spalte A zusammengefasst.

b) zusätzlich erscheinen die für mich wichtigen Werte in Zelle P7 und Zelle R7.

Für das Auslesen wäre es vernünftiger, auf diese Zellen zuzugreifen.

Bei der Anwendung Deines Makros wird jetzt kein Laufzeitfehler mehr angezeigt, aber weiterhin das Ergebnis: "keine" (hängt wohl mit a) zusammen, weil jetzt in B7 ind D7 keine Werte mehr stehen)

Kannst Du den Konvertierungsvorgang in das Makro einbauen  und den Zellzugriff (oben b) ) anpassen ?

Zu Deiner Frage: Ich suche mir die auszulesende Datei selbst aus.

Gruß Hardbopper