Private Sub Form_Current()
Dim dbs As Database, qdf As QueryDef
Dim fld As Field, rst As Recordset
Dim tbl As String
' Return reference to current database.
Set dbs = CurrentDb
' Return reference to Employees table.
Set qdf = dbs.QueryDefs("qryEquipment")
DoCmd.SetWarnings False
DoCmd.RunSQL ("Delete * from TableFields")
DoCmd.SetWarnings True
Set rst = dbs.OpenRecordset("TableFields", dbOpenDynaset)
' Enumerate all fields in Fields collection of TableDef object.
For Each fld In qdf.Fields
If fld.Type >= 1 And fld.Type <= 8 Or fld.Type = 10 Then
rst.AddNew
rst!FieldName = fld.Name
rst!FieldType = fld.Type
rst.Update
End If
Next fld
Set dbs = Nothing
lstLocalAuthority.Requery
'reset
Exit_cboQuery_AfterUpdate:
Exit Sub
Err_cboQuery_AfterUpdate:
MsgBox Err.Description
Resume Exit_cboQuery_AfterUpdate
End Sub
Private Sub cmdRunReport_Click()
On Error GoTo Err_cmdRunReport_Click
Dim MyDB As Database
Dim qdf As DAO.QueryDef
Dim rst As Recordset, rst2 As Recordset
Dim i As Integer, j As Integer, k As Integer, strSQL As String
Dim strFieldList As String, strIN As String
Dim flgAll As Boolean
'----------------------
Dim strWhere As String
Dim strFile As String
Const strcStub = "SELECT qryEquipment.* FROM qryEquipment" & vbCrLf
Const strcTail = "ORDER BY SomeField;"
Const strcExportQuery = "qryLocalAuthority"
If Me.FilterOn Then
strWhere = "WHERE " & Me.Filter & vbCrLf
End If
Set MyDB = CurrentDb()
Set rst = MyDB.OpenRecordset("tablefields")
strSQL = "SELECT "
j = 0
k = 0
rst.MoveFirst
'create the IN string by looping thru the listbox
For i = 0 To lstLocalAuthority.ListCount - 1
If lstLocalAuthority.Selected(i) Then
strIN = strIN & "[" & lstLocalAuthority.Column(0, i) & "] as Field" & k & ","
rst.Edit
rst!indexx = k
rst.Update
rst.MoveNext
k = k + 1
Else
rst.Edit
rst!indexx = Null
rst.Update
rst.MoveNext
End If
j = j + 1
Next i
For i = k To lstLocalAuthority.ListCount - 1
strIN = strIN & "null as Field" & i & ","
Next i
' stripoff the last comma of the IN string
strFieldList = Left(strIN, Len(strIN) - 1)
strSQL = strSQL & strFieldList & " FROM qryEquipment "
'MsgBox strSQL
MyDB.QueryDefs.Delete "qryLocalAuthority"
Set qdf = MyDB.CreateQueryDef("qryLocalAuthority", strSQL & strWhere)
strFile = "D:\DB\REPORT\MyExports.xls"
DoCmd.OutputTo acOutputQuery, "qryLocalAuthority", acFormatXLS, strFile
