Skip to main content
Tweeted twitter.com/StackCodeReview/status/779390308316577792
added 1 character in body
Source Link
emjaySX
  • 170
  • 5

My question on Stack Overflow was actually about this practice ("Dim as Object... set = CollectionDim as Object... set = Collection).

My question on Stack Overflow was actually about this practice ("Dim as Object... set = Collection).

My question on Stack Overflow was actually about this practice (Dim as Object... set = Collection).

deleted 128 characters in body
Source Link
Jamal
  • 35.2k
  • 13
  • 134
  • 238

I am posting here at the suggestion of Comintern (who I want to thank again!), though I'm a little apprehensive about displaying my amateurishness.

Based in part on an answer on StackOverflowStack Overflow, I bought "VBA Developer's Handbook"VBA Developer's Handbook and "Professional Excel Development"Professional Excel Development, but it took me a long time to 'get' classes (though I still have a long way to go).

I wrote myself a "GetExternalData"GetExternalData class, as one of the very common tasks I undertake in Excel VBA is incorporating data from other sources into my reports.

My thought was that the class could take care of deciding the best way of getting the data, based on the source and how the data is to be used, so my getExternalDatagetExternalData method was using a 'Variant' so that I could use the same variable whether I return a CollectionCollection, ArrayArray, DictionaryDictionary or WorksheetWorksheet.

My question on StackOverflowStack Overflow was actually about this practice ("Dim as Object... set = Collection).

1 - At the moment, I don't have anything coded for Access database connections

2 - I check the first element of a collection, and assume all items are similar types and have the same number of elements (for arrays)

3 - I know there's debate on the merits of Hungarian - at the moment, I find it useful (have been using it for a long time in Access (tbl, qry) and in VBA user-forms (txt, cmb), so implementing it into my VBA made sense - so I don't really want to get into that debate

4 - There's also mixed opinion on accessors vs public variables. If I create a letter then I create a getter, except where I'm storing the return Cols in a collection

  1. At the moment, I don't have anything coded for Access database connections

  2. I check the first element of a collection, and assume all items are similar types and have the same number of elements (for arrays)

  3. I know there's debate on the merits of Hungarian - at the moment, I find it useful (have been using it for a long time in Access (tbl, qry) and in VBA user-forms (txt, cmb), so implementing it into my VBA made sense - so I don't really want to get into that debate

  4. There's also mixed opinion on accessors vs public variables. If I create a letter then I create a getter, except where I'm storing the return Cols in a collection

I am posting here at the suggestion of Comintern (who I want to thank again!), though I'm a little apprehensive about displaying my amateurishness.

Based in part on an answer on StackOverflow, I bought "VBA Developer's Handbook" and "Professional Excel Development", but it took me a long time to 'get' classes (though I still have a long way to go).

I wrote myself a "GetExternalData" class, as one of the very common tasks I undertake in Excel VBA is incorporating data from other sources into my reports.

My thought was that the class could take care of deciding the best way of getting the data, based on the source and how the data is to be used, so my getExternalData method was using a 'Variant' so that I could use the same variable whether I return a Collection, Array, Dictionary or Worksheet.

My question on StackOverflow was actually about this practice ("Dim as Object... set = Collection)

1 - At the moment, I don't have anything coded for Access database connections

2 - I check the first element of a collection, and assume all items are similar types and have the same number of elements (for arrays)

3 - I know there's debate on the merits of Hungarian - at the moment, I find it useful (have been using it for a long time in Access (tbl, qry) and in VBA user-forms (txt, cmb), so implementing it into my VBA made sense - so I don't really want to get into that debate

4 - There's also mixed opinion on accessors vs public variables. If I create a letter then I create a getter, except where I'm storing the return Cols in a collection

Based in part on an answer on Stack Overflow, I bought VBA Developer's Handbook and Professional Excel Development, but it took me a long time to 'get' classes (though I still have a long way to go).

I wrote myself a GetExternalData class, as one of the very common tasks I undertake in Excel VBA is incorporating data from other sources into my reports.

My thought was that the class could take care of deciding the best way of getting the data, based on the source and how the data is to be used, so my getExternalData method was using a 'Variant' so that I could use the same variable whether I return a Collection, Array, Dictionary or Worksheet.

My question on Stack Overflow was actually about this practice ("Dim as Object... set = Collection).

  1. At the moment, I don't have anything coded for Access database connections

  2. I check the first element of a collection, and assume all items are similar types and have the same number of elements (for arrays)

  3. I know there's debate on the merits of Hungarian - at the moment, I find it useful (have been using it for a long time in Access (tbl, qry) and in VBA user-forms (txt, cmb), so implementing it into my VBA made sense - so I don't really want to get into that debate

  4. There's also mixed opinion on accessors vs public variables. If I create a letter then I create a getter, except where I'm storing the return Cols in a collection

Source Link
emjaySX
  • 170
  • 5

Class to retrieve external data

I am posting here at the suggestion of Comintern (who I want to thank again!), though I'm a little apprehensive about displaying my amateurishness.

I have recently come to use VBA class modules in my code.

Based in part on an answer on StackOverflow, I bought "VBA Developer's Handbook" and "Professional Excel Development", but it took me a long time to 'get' classes (though I still have a long way to go).

I wrote myself a "GetExternalData" class, as one of the very common tasks I undertake in Excel VBA is incorporating data from other sources into my reports.

My thought was that the class could take care of deciding the best way of getting the data, based on the source and how the data is to be used, so my getExternalData method was using a 'Variant' so that I could use the same variable whether I return a Collection, Array, Dictionary or Worksheet.

However, when I attempted to pass the Collection to another function which expects a collection I was getting an error. I noticed the locals window showed as 'Variant/Object/Collection', so I tried setting the value to an Object rather than a Variant which works.

My question on StackOverflow was actually about this practice ("Dim as Object... set = Collection)

TODO:

1 - At the moment, I don't have anything coded for Access database connections

2 - I check the first element of a collection, and assume all items are similar types and have the same number of elements (for arrays)

3 - I know there's debate on the merits of Hungarian - at the moment, I find it useful (have been using it for a long time in Access (tbl, qry) and in VBA user-forms (txt, cmb), so implementing it into my VBA made sense - so I don't really want to get into that debate

4 - There's also mixed opinion on accessors vs public variables. If I create a letter then I create a getter, except where I'm storing the return Cols in a collection

Option Explicit

Public Enum dataReturnType
   arrayVals
   collectionVals
   dictionaryVals
End Enum

Public Enum sourceFileType
   csv = 1 '
   xls = 10 'old Excel
   mdb 'old Access
   xlsx = 100 'new Excel
   xlsm 'new Excel macro-enabled
   accdb 'new Access
End Enum

Private Enum getDataMethod
   ADO_Record_Set
   Web_QT
End Enum

Private strFilePath As String
Private strFileName As String
Private enumFileType As sourceFileType
Private strConnString As String
Private strExtendedProperties As String
Private strSelectClause As String
Private strFromClause As String
Private colReturnFields As Collection
Private enumRetrievalMethod As getDataMethod
Private strFormatString As String
Private boolIMEX As Boolean
Private boolHDR As Boolean
Private intkeyCol As Integer
Private rngOutput as Range
Public WSname As String
Public WhereClause As String
Public RtnType As dataReturnType

Private Sub Class_Initialize()
   boolHDR = True
   boolIMEX = True
   Set colReturnFields = New Collection
   strSelectClause = "*"
End Sub

Property Let FilePath(fullPathOnly As String)
   If Left(fullPathOnly, 4) = "http" Then
      enumRetrievalMethod = Web_QT
      If Right(fullPathOnly, 1) = "/" Then strFilePath = fullPathOnly Else strFilePath = fullPathOnly & "/"
   Else
      enumRetrievalMethod = ADO_Record_Set
      If Right(fullPathOnly, 1) = "\" Then strFilePath = fullPathOnly Else strFilePath = fullPathOnly & "\"
    End If
End Property

Property Get FilePath() As String
   FilePath = strFilePath
End Property

Property Let FileName(fName As String)
   strFileName = fName
   Select Case Right(strFileName, Len(strFileName) - InStr(strFileName, "."))
      Case Is = "txt", "csv", "lst"
         enumFileType = csv
      Case Is = "xls"
         enumFileType = xls
      Case Is = "xlsx", "xlsb"
         enumFileType = xlsx
      Case Is = "xlsm"
         enumFileType = xlsm
      Case Is = "mdb"
         enumFileType = mdb
      Case Is = "accdb"
         enumFileType = accdb
   End Select
End Property

Property Get FileName() As String
   FileName = strFileName
End Property

Property Let ReturnFields(colNums As Variant)
    Dim colNum As Variant
    Select Case VarType(colNums)
      Case Is < vbVariant
         colReturnFields.Add colNums
    Case Else
      For Each colNum In colNums
        colReturnFields.Add colNum
      Next
   End Select
End Property

Property Let externalDataKeyColumn(colNum As Integer)
   intkeyCol = colNum
End Property
Property Get externalDataKeyColumn() As Integer
   externalDataKeyColumn = intkeyCol
End Property

Public Function getExternalData() As Variant
   Dim ReturnVals As Object
   Dim DataProcessor As Object
   Set DataProcessor = New DataProcessor
   Select Case enumRetrievalMethod
      Case Is = getDataMethod.ADO_Record_Set
         Set ReturnVals = doConnectRS
         Select Case Me.RtnType
            Case Is = dataReturnType.arrayVals
            getExternalData = DataProcessor.collection2Array(ReturnVals, Me.externalDataKeyColumn, True)
            Case Is = collectionVals
               Set getExternalData = ReturnVals
            Case Is = dictionaryVals
               Set getExternalData = New scripting.Dictionary
               Set getExternalData = DataProcessor.collection2Dictionary(ReturnVals, Me.externalDataKeyColumn)
         End Select
      Case Is = getDataMethod.Web_QT
         Set ReturnVals = doConnectQT
         Select Case Me.RtnType
            Case Is = dataReturnType.arrayVals
               getExternalData = ReturnVals.UsedRange
            Case Is = collectionVals
               Set getExternalData = DataProcessor.array2Collection(ReturnVals.UsedRange, Me.externalDataKeyColumn)
            Case Is = dictionaryVals
               Set getExternalData = DataProcessor.array2Dictionary(ReturnVals.UsedRange, Me.externalDataKeyColumn)
         End Select
   End Select
End Function

Private Function doConnectRS() As Collection
   'RecordSet Constants
   Const adOpenStatic = 3
   Const adLockOptimistic = 3
   Const adCmdText = &H1
   Dim dp As New DataProcessor
   Dim objRecordSet As Object, objConnection As Object
   Dim varRS As Variant
   Dim connString As String, SqlStatement As String
   Dim colNum As Integer, rowNum As Integer
   Dim colRS As New Collection
   Dim keyCol As Variant
   If Not compatibleSource Then Exit Function
   connString = getConnectionProperties
   SqlStatement = "Select " & strSelectClause & " FROM " & strFromClause
   If WhereClause <> vbNullString Then SqlStatement = SqlStatement & " WHERE " & WhereClause
   Set objConnection = CreateObject("ADODB.Connection")
   Set objRecordSet = CreateObject("ADODB.Recordset")
   objConnection.Open connString
   objRecordSet.Open SqlStatement, objConnection, adOpenStatic, adLockOptimistic, adCmdText
      If colReturnFields.Item(1) = "all" Then
         colReturnFields.Remove (1)
         For colNum = 1 To objRecordSet.Fields.Count
            colReturnFields.Add colNum
         Next
      End If
      Do Until objRecordSet.EOF
         ReDim varRS(1 To colReturnFields.Count)
         For colNum = 1 To colReturnFields.Count
            If IsNull(objRecordSet.Fields.Item(CLng(colReturnFields.Item(colNum) - 1))) Then
               varRS(colNum) = vbNullString 'If the SQL statement returns Null populate with vbNullString rather than Null
            Else
               varRS(colNum) = objRecordSet.Fields.Item(CLng(colReturnFields.Item(colNum) - 1))
            End If
         Next
         colRS.Add varRS
        objRecordSet.MoveNext
      Loop
      Set objRecordSet = Nothing
      Set objConnection = Nothing
   Set doConnectRS = colRS
End Function

Private Function compatibleSource() As Boolean
   Select Case enumFileType
      Case Is > xlsx
         If Application.Version < 12 Then
            MsgBox "Incompatible source file selected!", vbCritical
            compatibleSource = False
         Else
            compatibleSource = True
         End If
      Case Else
         compatibleSource = True
   End Select
End Function

Private Function getConnectionProperties()
Dim HDR As String
If boolHDR Then HDR = "HDR=YES" Else HDR = "HDR=NO"
Select Case enumFileType
   Case Is = xls
      strConnString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFilePath & strFileName & ";"
      strExtendedProperties = "Extended Properties=""Excel 8.0;"
      strFromClause = "[" & WSname & "$]"
   Case Is = csv
      strConnString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFilePath & ";"
      strExtendedProperties = "Extended Properties=""text; FMT=Delimited;"
      strFromClause = strFileName
   Case Is = xlsx
      strConnString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFilePath & strFileName & ";"
      strExtendedProperties = "Extended Properties=""Excel 12.0 Xml;"
      strFromClause = "[" & WSname & "$]"
   Case Is = xlsm
      strConnString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFilePath & strFileName & ";"
      strExtendedProperties = "Extended Properties=""Excel 12.0 Macro;"
      strFromClause = "[" & WSname & "$]"
End Select
getConnectionProperties = strConnString & strExtendedProperties & HDR & ";"
If boolIMEX Then getConnectionProperties = getConnectionProperties & "IMEX=1;"
getConnectionProperties = getConnectionProperties & """"
End Function

Private Function doConnectQT() As Worksheet

Dim ws As Worksheet
Dim qT As QueryTable

If rngOutput Is Nothing Then
   Set ws = Worksheets.Add
   Set rngOutput = ws.Range("a1")
Else
   Set ws = rngOutput.Parent
End If

myFileName = "URL; " & Me.FilePath & Me.FileName

    Set qT = ws.QueryTables.Add(Connection:=myFileName, Destination:=rngOutput)
      With qT
        .Name = "myQT"
        .fieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
         qT.Delete

Set doConnectQT = ws

End Function

For the sake of completeness, I will also post the 'DataProcessor' class which I use to convert the returned collection to a dictionary or array if needed

Public Function collection2Array(colIn As Collection, Optional ByVal keyCol As Integer, Optional writeOut As Boolean) As Variant
   Dim rowCount As Long, colCount As Long
   Dim arrOut As Variant
   
   Select Case VarType(colIn.Item(1))
     Case Is >= vbVariant 'if the collection contains arrays
         ReDim arrOut(1 To colIn.Count, 1 To UBound(colIn.Item(1))))
         For rowCount = 1 To UBound(colIn.Item(1))
            For colCount = 1 To UBound(arrOut, 2)
               arrOut(rowCount, colCount) = colIn.Item(rowCount)(colCount)
            Next
         Next
      Case Else
         If writeOut Then 'we'll return a 2D array with 1 column suitable for writing directly to a worksheet
            ReDim arrOut(1 To colIn.Count, 1 To 1)
            For rowCount = 1 To colIn.Count
               arrOut(rowCount, 1) = colIn.Item(rowCount)
            Next
         Else
            ReDim arrOut(1 To colIn.Count)
            For rowCount = 1 To colIn.Count
               arrOut(rowCount) = colIn.Item(rowCount)
            Next
         End If
   End Select
   collection2Array = arrOut
End Function

Public Function collection2Dictionary(colIn As Collection, Optional ByVal keyCol As Integer, Optional compareMode As VbCompareMethod = vbTextCompare) As scripting.Dictionary
   Dim colVal As Variant
   Set collection2Dictionary = New scripting.Dictionary
   collection2Dictionary.compareMode = compareMode
   If keyCol = 0 Then keyCol = 1
   For Each colVal In colIn
      collection2Dictionary.Item(colVal(keyCol)) = colVal
   Next
End Function