Visual basic MS Access ADODB example loop

Visual basic MS Access ADODB example loop

Option Compare Database
Option Explicit
Dim rs As New ADODB.Recordset
Dim EA As Excel.Application
Dim i As Integer, j, MyVal As Integer
Dim DA
Const Shablon As String = "\Path\Shablon.xlt"
Dim Zapros As String


Sub Something(view As String)
    Set EA = CreateObject("Excel.Application")
    EA.Workbooks.Add Template:=Application.CurrentProject.Path & Shablon
view = "SELECT * FROM " & view
rs.Open view, CurrentProject.Connection, adOpenKeyset, adLockOptimistic, adCmdText

    ReDim DA(0 To 0, 0 To rs.Fields.Count - 1)
    For j = 0 To rs.Fields.Count - 1
        DA(0, j) = rs.Fields(j).Name
    Next j
    EA.Range(EA.ActiveCell.Offset(0, 0), EA.ActiveCell.Offset(0, rs.Fields.Count - 1)).Formula = DA
    Erase DA
    rs.MoveLast
    ReDim DA(0 To rs.RecordCount - 1, 0 To rs.Fields.Count - 1)
    rs.MoveFirst
    i = 0
    Do While Not rs.EOF
        For j = 0 To rs.Fields.Count - 1
            DA(i, j) = rs(j)
        Next j
        rs.MoveNext
        i = i + 1
    Loop

    EA.Range(EA.ActiveCell.Offset(1, 0), EA.ActiveCell.Offset(rs.RecordCount, rs.Fields.Count - 1)).Formula = DA
    rs.Close
    Set rs = Nothing
    Zapros = Replace(Zapros, "]", "")
    Zapros = Replace(Zapros, "[", "")
    EA.ActiveWorkbook.SaveAs Application.CurrentProject.Path & "\" & Year(Date) & "-" & Month(Date) & "-" & Day(Date) & "_" & Zapros & "_file", xlExcel8, , , , , , True

    EA.Visible = True
    Set EA = Nothing
    End Sub





Private Sub button1_Click()
Dim i As Integer
Dim Imya  As String
Dim LB As ListBox
    Set LB = Me!Listbox1
    If LB.ListIndex < 0 Then
        Imya  = ""
        Exit Sub
    Else
        Imya  = Nz(LB)
    End If
    Set LB = Nothing
   
    Application.DoCmd.OpenForm
   ' Form_Listform.Repaint  
   ' If os = "Windows XP" Then Application.DoCmd.RepaintObject acForm, "Loading"
    Application.DoCmd.RepaintObject acForm, "Loading"
    Application.DoCmd.Hourglass True
     Something("[" & Imya  & "]")
    'Application.DoCmd.Close acForm, "Listform", acSaveYes
    Application.DoCmd.Hourglass False
   
    Application.DoCmd.Close acForm, "Loading", acSaveYes
    Application.DoCmd.RunCommand acCmdAppMinimize
End Sub