MS Excel

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

Zaslal/a Mira-2 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ěď >

MoNoM(23.2.2022 15:18)#052178

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

Barth(23.2.2022 16:50)#052180

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

Mira-2(2.3.2022 11:02)#052213

Děkuji,

je to ono.citovat

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

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje