для проекта ADP, где у вас нет локальных определений запросов MS Access, вы можете создать форму таблицы данных с несколькими текстовыми полями с именами txt1, txt2, .... txt30 и метками с именем lbl1 ... lb30, и этот код будетустановите form.recordsource и установите textbox.controlsource и label.caption в соответствующие поля из объекта набора записей ADO.Эта форма позволит вам просматривать набор записей ADO, аналогично методу Docmd.OpenQuery.
Вы должны передать инструкцию SQL набора записей ADO в форму, используя свойство OpenArgs формы.код ниже показывает код VBA для вызова \ открытия формы (которая показывает набор записей ADO как запрос) и передачи строки sql.Код vba в событии загрузки формы установит все свойства элемента управления, изменит размер столбцов с данными и скроет столбцы, у которых нет соответствующего поля, из набора записей ado:
'stevekirchner 09/29/2012 Replace Access parameterized query with SQL Server in-line function
'DoCmd.OpenQuery "qry_SearchMaster_CaseTitles", , acReadOnly
strsql = "Select * from dbo.UDF__qry_SearchMaster_CaseTitles ('%" & Me.tbxSearchTerm.Value & "%') "
Call Display_ADO_Recordset_from_Datasheet_Form(strsql, "frm_Display_ADO_Recordset_Result1")
'create a non-form module and put the code for the sub Display_ADO_Recordset_from_Datasheet_Form
'and function fIsLoaded in it (this will allow you make several forms to view ADO recordset and
'call the code from one place\module):
Sub Display_ADO_Recordset_from_Datasheet_Form(sSQL As String, sFormName As String)
On Error GoTo Error_Handler
If fIsLoaded(sFormName) Then
DoCmd.Close acForm, sFormName
End If
DoCmd.OpenForm sFormName, acFormDS, , , acFormReadOnly, , OpenArgs:=sSQL
Exit_Sub:
Exit Sub
Error_Handler:
MsgBox Err.Description & " Error No: " & CStr(Err.Number)
Resume Exit_Sub
End Sub
Function fIsLoaded(ByVal strFormname As String) As Boolean
On Error GoTo Error_Handler
'Returns False if form is not open or True if Open
If SysCmd(acSysCmdGetObjectState, acForm, strFormname) <> 0 Then
If Forms(strFormname).CurrentView <> 0 Then
fIsLoaded = True
End If
End If
Exit_Function:
Exit Function
Error_Handler:
MsgBox Err.Description & " Error No: " & CStr(Err.Number)
fIsLoaded = False
Resume Exit_Function
End Function
'Create a datasheet view form (named frm_Display_ADO_Recordset_Result1) with 30 textboxes and 30
'30 labels named txt1 - txt30 and lbl1 - lbl30 and put this code in the form's module:
Option Compare Database
Private Sub Form_Load()
On Error GoTo Error_Handler
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim rsClone As ADODB.Recordset
Dim strsql As String
Set conn = CurrentProject.Connection
Set rs = New ADODB.Recordset
strsql = Me.OpenArgs
rs.Open strsql, conn, adOpenStatic, adLockOptimistic
Set rsClone = rs.Clone
Call Update_Form_Controls("your text goes here", strsql, rsClone)
Exit_Sub:
rs.Close
conn.Close
Set rs = Nothing
Set conn = Nothing
Exit Sub
Error_Handler:
MsgBox Err.Description & "; Error Number : " & Err.Number, vbOKOnly
Resume Exit_Sub
End Sub
Sub Update_Form_Controls(Header_Label As String, SQL As String, CloneRS As Recordset)
Dim rsCount As Integer
Dim i As Integer
On Error GoTo Error_Handler
Me.Form.Caption = Replace(SQL, "Select * From ", "Display: ")
rsCount = CloneRS.RecordCount
If rsCount <= 0 Then
MsgBox "The Query did not return any data to view", vbOKOnly
DoCmd.Close
Else
Me.Form.SetFocus
Me.RecordSource = SQL
i = 1
Do Until i = 31
Me("lbl" & i).Caption = ""
Me("txt" & i).ControlSource = ""
Me("txt" & i).ColumnHidden = True
i = i + 1
Loop
i = 1
With CloneRS
For Each Field In .Fields
On Error Resume Next
Me("lbl" & i).Caption = .Fields(i - 1).Name
Me("txt" & i).ControlSource = .Fields(i - 1).Name
Me("lbl" & i).Visible = True
Me("txt" & i).ColumnHidden = False
Me("txt" & i).SizeToFit
i = i + 1
'Debug.Print Field.Name
On Error GoTo 0
Next Field
End With
End If
Exit_Sub:
Me.Requery
Exit Sub
Error_Handler:
MsgBox Err.Description & "; Error Number : " & Err.Number, vbOKOnly
Resume Exit_Sub
End Sub