Extract Data from MS Access 2010 to Excel using ADODB Connection

Option Explicit
Dim conn As ADODB.Connection, i As Integer
Dim rst As ADODB.Recordset, querystring As String
Sub accesData()
Set conn = New ADODB.Connection
Set rst = New ADODB.Recordset
i = 1
querystring = "Select [Order Id], sum(([Unit Price]*Quantity))  as Sales  from [Order Details] group  by [Order Id]"
conn.ConnectionString = "Provider=Microsoft.Access.OLEDB.10.0;Persist Security Info=False;Data Source=somu"
conn.Open
conn.CursorLocation = adUseClient
rst.Open querystring, conn, adOpenStatic
    Do While Not rst.EOF
        ThisWorkbook.Sheets(1).Range("A" & (i + 1)) = rst.Fields(0).Value
        ThisWorkbook.Sheets(1).Range("B" & (i + 1)) = rst.Fields(1).Value
        rst.MoveNext
        i = i + 1
    Loop
rst.Close
conn.Close
Set rst = Nothing
Set conn = Nothing
End Sub


Download Excel

Sample Database

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

Add Form Control CheckBox in VBA

objrng.Offset(k, 0) = rst.Fields(0).Value
                'add check box
                ThisWorkbook.Sheets(shtcnt).CheckBoxes.Add(Left:=objrng.Offset(k, 1).Left, Top:=objrng.Offset(k, 1).Top, Width:=objrng.Offset(k, 1).Width, Height:=objrng.Offset(k, 1).Height).Select
                ThisWorkbook.Sheets(shtcnt).Range(objrng.Offset(k, 1).Address).NumberFormat = ";;;"
                With Selection
               
                    .Caption = ""
                    .Name = ""
               
                    .LinkedCell = objrng.Offset(k, 1).Address
                End With

Using ShellExecute to open an .exe File

Public Declare Function ShellExecute _
    Lib "shell32.dll" _
        Alias "ShellExecuteA" ( _
            ByVal Hwnd As Long, _
            ByVal lpOperation As String, _
            ByVal lpFile As String, _
            ByVal lpParameters As String, _
            ByVal lpDirectory As String, _
            ByVal nShowCmd As Long) _
As Long
Sub my_Procedure()
pathname = "C:\Program Files (x86)\TechSmith\Camtasia Studio 8\CamRecorder.exe"


'ThisWorkbook.Windows(1).WindowState = xlMinimized
procId = ShellExecute(0, "Open", pathname, vbNullString, "C:\", SW_SHOWNORMAL)
Application.Wait (Now + TimeValue("00:00:03"))
'AppActivate procId
Application.SendKeys ("{F9}"), True


end Sub

Select Query with Case

Select t3.LocationName, t1.CourseSDate,t1.CourseEDate,
CASE WHEN GI.CorporateId = 0 THEN GI.CompanyName ELSE CO.CORPORATENAME END AS ComapyName , ' ' as Venue from TRAN_SCINTERESTEDCOURSES t1
INNER JOIN TRAN_SCGENERALINFO GI ON T1.StudnetCardId = GI.StudnetCardId
 left JOIN MST_LOCATION t3 on t3.LocationId=t1.LocationId
 LEFT JOIN MST_CORPORATEDETAIL CO ON CO.CORPORATEID = GI.CorporateId where T1.StudnetCardId=4127