ThrottleWorks
Excel Ninja
Hi,
This is a MS Access Query.
My apologies if this is not allowed.
I want to use where clause in query from Excel VBA.
I am not able to do it, I tried various options from Google but could not succeed.
I want to select data WHERE Name = 'ThrottleWorks'.
I can do it in MS Access but not able to do it with VBA.
Can anyone please help me in this.
This is a MS Access Query.
My apologies if this is not allowed.
I want to use where clause in query from Excel VBA.
I am not able to do it, I tried various options from Google but could not succeed.
I want to select data WHERE Name = 'ThrottleWorks'.
I can do it in MS Access but not able to do it with VBA.
Can anyone please help me in this.
Code:
Option Explicit
Sub Import_Access_Data()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim My_ADOB_Connection As ADODB.Connection
Dim My_Record_Set As ADODB.Recordset
Dim sQRY As String
Dim strFilePath As String
Dim MacroBook As Workbook
Dim Sht_1 As Worksheet
Dim Sht_2 As Worksheet
Dim i As Long
Dim TempLr As Long
Set MacroBook = ThisWorkbook
Set Sht_1 = MacroBook.Worksheets("Sheet1")
Set Sht_2 = MacroBook.Worksheets("Sheet2")
TempLr = Sht_1.Cells(Sht_1.Rows.Count, 5).End(xlUp).Row + 1
Sht_1.Cells(TempLr, 5) = Now
Sht_2.Cells.ClearContents
Sht_2.Cells.Clear
strFilePath = Sht_1.Range("A2")
Set My_ADOB_Connection = New ADODB.Connection
Set My_Record_Set = New ADODB.Recordset
My_ADOB_Connection.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & strFilePath & ";"
sQRY = "SELECT * FROM Employee_Data"
My_Record_Set.CursorLocation = adUseClient
My_Record_Set.Open sQRY, My_ADOB_Connection, adOpenStatic, adLockReadOnly
With Sht_2
For i = 1 To My_Record_Set.Fields.Count
.Cells(1, i).Value = My_Record_Set.Fields(i - 1).Name 'fields is a 0 based collection
Next i
End With
Sht_2.Range("A2").CopyFromRecordset My_Record_Set
My_Record_Set.Close
Set My_Record_Set = Nothing
My_ADOB_Connection.Close
Set My_ADOB_Connection = Nothing
Sht_1.Cells(TempLr, 6) = Now
MsgBox "Done !"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub