< návrat zpět

MS Excel


Téma: Načtení názvů bez metody .open, která zdržuje rss

Zaslal/a 23.2.2022 14:27

Předchozí dotaz si dovoluji upřesnit, omlouvám se, nevím si rady:
Potřebuji načíst do pole(Array) názvy oušek(u nás čísla výrobků) asi ze 1 400 souborů zhruba po deseti listech. Potom projíždím jen podle kritéria vybrané soubory (pomocí .open) a mimo jiné hledám duplicity v číslech výrobků. Už jenom to projetí vybraných souborů je dlouhé. Otevírání a zavírání 1 400 souborů potom superdlouhé. Čtení oušek v aktuálním souboru je jednoduchá akce. Potřebuji efektivně projít těch 1 400 souborů, jinak je to na hodiny, kdy mám zablokovanou celou aplikaci MS Excel.

Zaslat odpověď >

#052178
avatar
Našel jsem načtení pomocí ADO, nezkoušel jsem:
http://wizardvba.blogspot.com/2013/03/get-sheet-names-without-opening.html
Ještě by mohlo stát za úvahu, že XLSX soubor je vlastně zazipovaný XML dokument - takže by mohlo jít přejmenovat soubor na ZIP a "šáhnout si" dovnitř toho ZIPu na vhodné místo/místa, kde se nachází jména listů. Více o struktuře XLSX souboru:
http://officeopenxml.com/anatomyofOOXML-xlsx.php
https://professor-excel.com/xml-zip-excel-file-structure/ citovat
#052180
avatar
Excel connection strings
https://www.connectionstrings.com/excel/

Při použití metody Connection.OpenSchema postačí Connection a Recordset, instanci connection vytvoří CreateObject, tak není nutné přidat reference do VBA projektu.
Function GetWorksheetNames(ByVal file_path As String) As Collection
Dim cn As Object, rs As Object
Set GetWorksheetNames = New Collection
Set cn = CreateObject("ADODB.Connection")
a_connection_string = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source={0};" & _
"Extended Properties=""Excel 12.0 {1};HDR=YES"";"
a_connection_string = Replace(a_connection_string, "{0}", file_path)
If Right(file_path, 4) = "xlsm" Then
a_connection_string = Replace(a_connection_string, "{1}", "Macro")
Else
a_connection_string = Replace(a_connection_string, "{1}", "Xml")
End If
cn.Open a_connection_string

Set rs = cn.OpenSchema(20) 'adSchemaTables=20
Do While Not rs.EOF
GetWorksheetNames.Add Left(rs("TABLE_NAME"), Len(rs("TABLE_NAME")) - 1) 'without $
rs.MoveNext
Loop
If cn.State = 1 Then 'adStateOpen=1
cn.Close
End If
Set rs = Nothing
Set cn = Nothing
End Function

Sub CallFunctionAndReturnNames()
Dim worksheet_names As Collection, i As Integer
Set worksheet_names = GetWorksheetNames("C:\Sešit.xlsx")

ReDim array_names(1 To worksheet_names.Count)
For i = 1 To worksheet_names.Count
array_names(i) = worksheet_names(i)
Next
MsgBox Join(array_names, ",")
End Sub


Těžko říct, snad bude trochu rychlejší, třeba to zkuste.citovat
#052213
avatar
Děkuji,

je to ono.citovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Aktivní diskuse

odpocet a storno tl.

PavDD • 28.3. 8:53

odpocet a storno tl.

Začátečník • 26.3. 14:39

odpocet a storno tl.

PavDD • 26.3. 10:22

odpocet a storno tl.

elninoslov • 26.3. 7:50

odpocet a storno tl.

PavDD • 26.3. 7:26

odpocet a storno tl.

elninoslov • 25.3. 22:34

odpocet a storno tl.

Začátečník • 25.3. 15:09