Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1292to1296
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Tabellennamen geschlossener Arbeitsmappe lesen

Tabellennamen geschlossener Arbeitsmappe lesen
11.01.2013 14:39:37
Sandra
Hallo,
ich nutze im Moment folgenden Code, um die Dateinamen eines (geschlossenen) Ordners auszulesen:
Sub GeschlosseneMappenListen()
Dim fs As Object
Dim fverz As Object
Dim fDatei As Object
Dim FDateien As Object
Dim strDat As String
Dim x As Integer
x = 1
Set fs = CreateObject("Scripting.Filesystemobject")
Set fverz = fs.getfolder("G:\...")
Set FDateien = fverz.Files
For Each fDatei In FDateien
If InStr(fDatei, "xl") > 0 Then
strDat = strDat & fDatei.Name & vbLf
End If
x = x + 1
Cells(2, x).Value = strDat
strDat = ""
Next fDatei
End Sub
Nun möchte ich die Namen aller Tabellenblätter innerhalb einer (geschlossenen) Datei auslesen und auflisten. Ich habe schon versucht, den o.g. Code hierfür anzupassen, jedoch ohne Erfolg. Kann mir jemand von euch hierbei weiterhelfen?
Danke und Gruß
Sandra

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
XL-Dateien und Tabellennamen auflisten
11.01.2013 15:48:07
NoNet
Hallo Sandra,
ich habe Deinen Code etwas modifiziert und ergänzt - jetzt werden die Dateinamen untereinander (in ein neues Blatt) aufgelistet und jeweils rechts daneben die enthaltenen Blätter.
Zum Auslesen der Tabellenblattnamen müssen die Dateien jedoch kurzzeitig geöffnet werden !
Bei meinen Daten funktioniert das Makro recht gut - Probleme könnte es allenfalls mit geschützten Mappen geben oder bei Mappen mit Workbook_Open() Makros !
Den Ordnernamen "C:\Temp\" musst Du zuvor natürlich anpassen ;-)
Option Explicit
'Makro zum Auflisten aller XL-Dateiene eines Verzeichnisses (ohne Unterverzeichnisse !)
'und Auflisten der darin enthaltenen Blätter (sofern nicht geschützt)
'11.01.2013, NoNet - www.excelei.de
Dim lngZ As Long
Sub GeschlosseneMappenListen()
Dim fs As Object
Dim fverz As Object
Dim fDatei As Object
Dim FDateien As Object
Dim strOrdner As String
Dim strTyp As String
lngZ = 1
strOrdner = "C:\Temp\" 'Ordnername mit "\" am Ende !
Set fs = CreateObject("Scripting.Filesystemobject")
Set fverz = fs.getfolder(strOrdner)
Set FDateien = fverz.Files
Application.EnableEvents = False 'keine Events ausführen !
Sheets.Add 'neues Blatt einfügen)
ActiveSheet.Name = "XL-Liste " & Format(Now, "YYYY-MM-DD hh-mm-ss")
[A1] = "Filename"
[B1] = "Sheets"
[C1] = "Sheet names"
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
lngZ = lngZ + 1
Cells(lngZ, 1).Value = fDatei.Name
GetTabs (strOrdner & fDatei.Name)
End If
Next fDatei
Columns.AutoFit
Application.EnableEvents = True 'Events wieder ausführen !
MsgBox "Fertig !"
End Sub
Sub GetTabs(strDateiname)
Dim wsAkt As Worksheet, objXL, objWB, lngS As Long
Set wsAkt = ActiveSheet
Set objXL = GetObject(, "Excel.Application")
Set objWB = objXL.Workbooks.Open(Filename:=strDateiname, UpdateLinks:=False, ReadOnly:=True) _
wsAkt.Cells(lngZ, 2) = objWB.Sheets.Count
For lngS = 1 To objWB.Sheets.Count
wsAkt.Cells(lngZ, lngS + 2) = objWB.Sheets(lngS).Name
Next
Application.DisplayAlerts = False 'Keine Meldungen/Nachfragen beim Schließen anzeigen
objWB.Close
Set objWB = Nothing
Set objXL = Nothing
End Sub
Gruß, NoNet

Anzeige
geht auch geschlossen...
11.01.2013 15:54:54
Sheldon
Hallo Sandra,
NoNets Code sieht sehr gut aus, ich will nur noch einen anderen Ansatz fürs Auslesen "geschlossener" Dateien aufzeigen, den ich selbst vor einiger Zeit hier im Forum gelernt habe, siehe auch hier.
Ich habe wie NoNet Deinen Code als Grundlage genommen und ein wenig angepasst. Teste mal, ob der so funktioniert wie er soll. Allerdings finde ich NoNets Ansatz mit einer Zelle für jede Datei auch sehr schön, die Tabellenblätter könntest Du ja z. B. in den Spalten rechts neben dem Dateinamen auflisten!
Sub GeschlosseneMappenListen()
Dim fs As Object
Dim fverz As Object
Dim fDatei As Object
Dim FDateien As Object
Dim strDat As String
Dim x As Integer
Dim oWS As Worksheet, oWB As Workbook, oEA As Object, strTabs As String
x = 1
Set fs = CreateObject("Scripting.Filesystemobject")
Set fverz = fs.getfolder("G:\...")
Set FDateien = fverz.Files
Set oEA = CreateObject("Excel.Application")
For Each fDatei In FDateien
If InStr(fDatei, "xl") > 0 Then
Set oWB = oEA.Workbooks.Open(fDatei.Name, 0, True)
strTabs = ""
For Each oWS In oWB.Sheets
strTabs = strTabs & oWS.Name & ", "
Next
strTabs = Left(strTabs, Len(strTabs) - 2)
strDat = strDat & fDatei.Name & " - " & strTabs & vbCrLf
End If
x = x + 1
Cells(2, x).Value = strDat
strDat = ""
Next fDatei
oEA.Quit
Set oWS = Nothing
Set oWB = Nothing
Set oEA = Nothing
Set fs = Nothing
Set fverz = Nothing
Set FDateien = Nothing
End Sub

Gruß
Sheldon

Anzeige
AW: geht auch geschlossen...
11.01.2013 16:10:31
Sandra
Hallo Sheldon,
danke für deine Antwort.
Ich habe deinen Code ausprobiert, bekomme jedoch in der Zeile
Set oWB = oEA.Workbooks.Open(fDatei.Name, 0, True)
folgende Fehlermeldung:
"anwendungs- oder objektbezogener Fehler".
Danke auch an NoNet: Ich versuche deinen Vorschlag bzgl. einer Zelle pro Datei mit umzusetzen.
Gruß
Sandra

AW: sorry...
11.01.2013 19:38:01
Sheldon
Hallo Sandra,
...das kommt davon, wenn ich den Code einfach so schreibe und nix teste. Ändere mal diese Zeile:
Set oWB = oEA.Workbooks.Open(fDatei.Name, 0, True)
in
Set oWB = oEA.Workbooks.Open(fDatei, 0, True)
Dann funktioniert es.
Gruß
Sheldon

Anzeige
noch ne Ergänzung
11.01.2013 19:43:11
Sheldon
Hallo nochmals, Sandra,
ich habe der Schönheit und Funktionalität halber noch eine Zeile ergänzt. Hier ist nochmal der ganze Code, neue Zeile ist fett gedruckt:
Sub GeschlosseneMappenListen()
Dim fs As Object
Dim fverz As Object
Dim fDatei As Object
Dim FDateien As Object
Dim strDat As String
Dim x As Integer
Dim oWS As Worksheet, oWB As Workbook, oEA As Object, strTabs As String
x = 1
Set fs = CreateObject("Scripting.Filesystemobject")
Set fverz = fs.getfolder("G:\...")
Set FDateien = fverz.Files
Set oEA = CreateObject("Excel.Application")
For Each fDatei In FDateien
If InStr(fDatei, "xl") > 0 Then
Set oWB = oEA.Workbooks.Open(fDatei, 0, True)
strTabs = ""
For Each oWS In oWB.Sheets
strTabs = strTabs & oWS.Name & ", "
Next
strTabs = Left(strTabs, Len(strTabs) - 2)
strDat = strDat & fDatei.Name & " - " & strTabs & vbCrLf
End If
x = x + 1
Cells(x, 2).Value = strDat
strDat = ""
oWB.Close SaveChanges:=False
Next fDatei
oEA.Quit
Set oWS = Nothing
Set oWB = Nothing
Set oEA = Nothing
Set fs = Nothing
Set fverz = Nothing
Set FDateien = Nothing
End Sub

Gruß
Sheldon

Anzeige
Tabellennamen geschlossener Arbeitsmappe lesen
11.01.2013 17:40:44
Anton
Hallo ,
noch eine Variante:
Sub GeschlosseneMappenListen()
Dim fs As Object
Dim fDatei As Object
Dim zeile As Long
Dim spalte As Integer
Dim dao As Object
Dim db As Object
Dim tabelle As Object
zeile = 2
Set fs = CreateObject("Scripting.Filesystemobject")
For Each fDatei In fs.getfolder("c:\tmp").Files 'Pfad anpassen
If LCase(fs.GetExtensionName(fDatei)) = "xls" Then
spalte = 1
Cells(zeile, spalte).Value = fDatei.Name
Set dao = CreateObject("DAO.DBEngine.36")
Set db = dao.OpenDatabase(fDatei, False, True, "Excel 8.0;")
For Each tabelle In db.TableDefs
spalte = spalte + 1
Cells(zeile, spalte) = Left(tabelle.Name, Len(tabelle.Name) - 1)
Next
db.Close
Set dao = Nothing
End If
zeile = zeile + 1
Next fDatei
Set fs = Nothing
End Sub

mfg Anton

Anzeige
Pfad bis zum Tabellenblattnamen auslesen
13.01.2013 16:00:54
Sandra
Hallo zusammen,
ich habe die Vorschläge von NoNet und Shelon bereits umsetzen können, jedoch habe ich nun das Problem, dass der Name des jeweiligen Tabellenblattes alleine nicht mehr ausreichend ist. Ich benötige nun die komplette Pfadangabe bis hin zu den jeweiligen Tabellenblättern einer Arbeitsmappe. Zum Hintergrund: ich bastele an einer Index-Formel, welche jedoch, aufgrund der zu langen Pfadangaben in Bezug auf eine geschlossene Arbeitsmappe, nicht umzusetzen ist. Nun möchte ich die Pfadangaben in der Formel durch den Bezug auf den Inhalt derjenigen Zelle ergänzen, in die die Pfadangabe ausgelesen wird.
Auch hier habe ich bereits eine Lösung gefunden, welche sich jedoch wieder nur auf das Auslesen des Pfads bis hin zum Datei-, jedoch zum Tabellenblattnamen eignet:
Sub Test()
Dim fs As Object
Dim fverz As Object
Dim fDatei As Object
Dim FDateien As Object
Dim strDat As String
Dim lngzaehler As Long
lngzaehler = 1
Set fs = CreateObject("Scripting.Filesystemobject")
Set fverz = fs.getfolder("G:\...")
Set FDateien = fverz.Files
For Each fDatei In FDateien
If InStr(fDatei, "xl") > 0 Then
Tabelle1.Cells(lngzaehler, 11).Value = fDatei
lngzaehler = lngzaehler + 1
End If
Next fDatei
End Sub
Meine VBA-Kenntnisse reichen leider nicht, um den Code auf Tabellenblatt-Ebene umzuschreiben. Könntet ihr mir behilflich sein?
Danke und Gruß
Sandra

Anzeige
Pfad, Datei, Sheets
13.01.2013 16:42:31
Sheldon
Hallo Sandra,
eigentlich wars ja nur noch zusammenkopieren der schon vorhandenen Codes. Oder in Deinem Fall, abändern der einen Zeile im schon vorhandenen Code...
Sub Test()
Dim fs As Object
Dim fverz As Object
Dim fDatei As Object
Dim FDateien As Object
Dim strDat As String
Dim lngzaehler As Long
Dim SpaltenOffset As Integer
Dim oWS As Worksheet, oWB As Workbook, oEA As Object, WSZaehler As Integer
lngzaehler = 1
SpaltenOffset = 11
Set fs = CreateObject("Scripting.Filesystemobject")
Set fverz = fs.getfolder("E:\Downloads\Herber")     '("G:\...")
Set FDateien = fverz.Files
Set oEA = CreateObject("Excel.Application")
For Each fDatei In FDateien
If InStr(fDatei, "xl") > 0 Then
Tabelle1.Cells(lngzaehler, SpaltenOffset).Value = fDatei
Set oWB = oEA.Workbooks.Open(fDatei, 0, True)
WSZaehler = 1
For Each oWS In oWB.Sheets
Tabelle1.Cells(lngzaehler, SpaltenOffset + WSZaehler).Value = oWS.Name
WSZaehler = WSZaehler + 1
Next
oWB.Close SaveChanges:=False
lngzaehler = lngzaehler + 1
End If
Next fDatei
Set fs = Nothing
Set fverz = Nothing
Set FDateien = Nothing
Set oEA = Nothing
Set oWB = Nothing
End Sub

Zu beachten: es empfielt sich, stets die nicht mehr benötigten Objekte, die man zuvor mit dem Set-Befehl definiert hat, wieder zu entladen mit Set [Ovjektvariable] = Nothing. Während der Laufzeit könnte sonst eine solche Routine sehr oft aufgerufen werden und würde dann nach und nach den Arbeitsspeicher zum Überlaufen bringen.
Gruß
Sheldon
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige