Type Sql Query in input box and import data to excel from Access Table
Sub import_data()
' Tools Refrences set microsoft active x object
' clear exiting data
Dim sqlstring As String
Sheet1.Range("a1").CurrentRegion.Clear
sqlstring = InputBox("Enter the Query")
Call get_data(sqlstring, Sheet1.Range("a1"), 1)
End Sub
Sub get_data(strQry As String, rng_to_paste As Range, fld_name As Boolean)
Dim rs As ADODB.Recordset
Dim cnn As ADODB.Connection
Dim i As Long
Dim dbpath As String
Set rs = New ADODB.Recordset
Set cnn = New ADODB.Connection
'change database path here
dbpath = ThisWorkbook.Path & "\database.accdb"
' create the connection
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Open dbpath
End With
rs.CursorLocation = adUseClient
rs.cursortype = adOpenDynamic
rs.locktype = adLockOptimistic
rs.Open strQry, cnn
If fld_name = True Then
For i = 1 To rs.Fields.Count
rng_to_paste.Offset(0, i - 1).Value = rs.Fields(i - 1).Name
Next
rng_to_paste.Offset(1, 0).CopyFromRecordset rs
Else
rng_to_paste.CopyFromRecordset rs
End If
rs.Close
cnn.Close
End Sub
Sub import_data()
' Tools Refrences set microsoft active x object
' clear exiting data
Dim sqlstring As String
Sheet1.Range("a1").CurrentRegion.Clear
sqlstring = InputBox("Enter the Query")
Call get_data(sqlstring, Sheet1.Range("a1"), 1)
End Sub
Sub get_data(strQry As String, rng_to_paste As Range, fld_name As Boolean)
Dim rs As ADODB.Recordset
Dim cnn As ADODB.Connection
Dim i As Long
Dim dbpath As String
Set rs = New ADODB.Recordset
Set cnn = New ADODB.Connection
'change database path here
dbpath = ThisWorkbook.Path & "\database.accdb"
' create the connection
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Open dbpath
End With
rs.CursorLocation = adUseClient
rs.cursortype = adOpenDynamic
rs.locktype = adLockOptimistic
rs.Open strQry, cnn
If fld_name = True Then
For i = 1 To rs.Fields.Count
rng_to_paste.Offset(0, i - 1).Value = rs.Fields(i - 1).Name
Next
rng_to_paste.Offset(1, 0).CopyFromRecordset rs
Else
rng_to_paste.CopyFromRecordset rs
End If
rs.Close
cnn.Close
End Sub
No comments:
Post a Comment