Read Complete Excel into Multi-Dimensional Dictionary object by ADO
Public Function Func_ReadXL_IN_Dictionary(xlFilePath,xlSheetName)
On error resume next
Dim ADO,rs,rowCounter,TCName
Set ADO=CreateObject("ADODB.Connection")
Set objDict=CreateObject("Scripting.Dictionary")
ADO.Open "DRIVER={Microsoft Excel Driver (*.xls)};DBQ="& xlFilePath &";Readonly=True"
Set rs=createobject("ADODB.recordset")
rs.Open "Select * from [" & xlSheetName & "$]",ADO
Dim LoopCounter:LoopCounter=0
DO
' rowCounter=0
LoopCounter=LoopCounter+1
rowCounter=0
For each field in rs.Fields
rowCounter=rowCounter+1
If LoopCounter=1 Then
if rowCounter=1 Then
TCName= field.name
objDict.Add TCName,CreateObject("Scripting.Dictionary")
objDict(TCName).add field.name,field.name
Else
If isempty(field.name)=False Then
objDict(TCName).add field.name,field.name
End If
End if
else
if rowCounter=1 Then
TCName= field.value
objDict.Add TCName,CreateObject("Scripting.Dictionary")
objDict(TCName).add field.name,field.value
Else
If isempty(field.value)=False Then
objDict(TCName).add field.name,field.value
End If
End if
End If
Next
If LoopCounter <> 1 Then
rs.MoveNext
End If
Loop until rs.EOF
Set rs=Nothing
Set ADO=Nothing
set Func_ReadXL_IN_Dictionary=objDict
Set objDict=Nothing
On error goto 0
End Function
Comments
Post a Comment