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

Popular posts from this blog

Arrays

What is the difference between eval, execute and executeglobal.

Sample Test Strategy for a MicroService Project with APIs only