Thursday, October 20, 2016

Create and Populate ListBox from MSSQL Database

Set conn = New ADODB.Connection
    Set rst = New ADODB.Recordset
   
    conn.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Data Source=.;Initial Catalog=CourseMasterDB;"
    conn.Open
    querystring = "Select GeoName from MST_Geo"
    i = 0
    k = 3
   
           
            rst.Open querystring, conn, adOpenStatic
            ReDim geoArray(rst.RecordCount)
            Do While Not rst.EOF
            geoArray(i) = rst.Fields(0).Value
            rst.MoveNext
            i = i + 1
            Loop
   
            rst.Close
            conn.Close
            Set rst = Nothing
            Set conn = Nothing
           For k = 3 To ThisWorkbook.Sheets.Count
                            Set lookuprng = ThisWorkbook.Sheets(k).Columns("J:J").Find("Select GEO", LookIn:=xlValues, lookat:=xlWhole)
                            If (Not lookuprng Is Nothing) Then
                             ThisWorkbook.Sheets(k).Range(lookuprng.Address).ClearContents
                             ThisWorkbook.Sheets(k).Range(lookuprng.Offset(0, 1).Address).Validation.Delete
                            End If
                            rowcount = ThisWorkbook.Sheets(k).Range("J" & Rows.Count).End(xlUp).Row
                            ThisWorkbook.Sheets(k).Range("J" & (rowcount + 15)) = "Select GEO"
                            ThisWorkbook.Sheets(k).Range("J" & (rowcount + 15)).FontSize = 15
                            ThisWorkbook.Sheets(k).Range("J" & (rowcount + 15)).Interior.ColorIndex = 24
                         With ThisWorkbook.Sheets(k).Range("K" & (rowcount + 15)).Validation
                             .Delete
                             .Add Type:=xlValidateList, Formula1:=Join(geoArray, ",")
                             .InCellDropdown = True
                             .InputTitle = ""
                             .ErrorTitle = ""
                             .InputMessage = ""
                             .ErrorMessage = ""
                             .ShowInput = True
                             .ShowError = True
                        End With

No comments:

Post a Comment