Sub Main()
        Dim Root As String
        Root = "C:\Crypto\Crypto\"
        'Root = "C:\Crypto\Crypto\"
        Dim ExcelObj As Excel.Application = CreateObject("Excel.Application")
        Dim ExcelBook As Excel.Workbook = ExcelObj.Workbooks.Open(Root + "pat.xls")
        '-------Выгрузка отчета--------------------
        ExcelBook.Worksheets().Item( 2 ).Cells.Range("A4", "IV65536").ClearContents()
        Dim con As Object
        Dim rst As Object
        Dim Command1 As String
        Dim Command2 As String
        con = CreateObject("ADODB.Connection")
        rst = CreateObject("ADODB.Recordset")
        con.ConnectionTimeout =  0 
        con.CommandTimeout =  0 
        con.Open("Data Source=xxx;User Id=xxx;Password=xxx;QueryTimeout=0")
        '============SQL =========
        Command1 = "use reportdb SELECT * from CMP0513_GE_CONTACTS"
        '=========================
        rst = con.Execute(Command1)
        Dim Kolonka
        Dim i As Integer

        i =  2 
        Kolonka =  1 
        Do Until rst.EOF
            Kolonka =  1 
            Do Until Kolonka > rst.Fields.Count
                ExcelBook.Worksheets().Item( 2 ).Cells(i, Kolonka).Value = rst.Fields(Kolonka -  1 ).value.ToString
                Kolonka = Kolonka +  1 
            Loop
            i = i +  1 
            rst.MoveNext()
        Loop

        Try
            rst.Close()
            con.Close()
        Catch ex As Exception
        End Try
        ExcelBook.Worksheets().Item( 1 ).Cells.Range("A4", "IV65536").ClearContents()
        con = CreateObject("ADODB.Connection")
        rst = CreateObject("ADODB.Recordset")
        con.ConnectionTimeout =  0 
        con.CommandTimeout =  0 
        con.Open("Data Source=xxx;User Id=xxx;Password=xxx;QueryTimeout=0")
        '============SQL =========
        Command1 = "use reportdb SELECT * from GE_STATISTIC ORDER BY Дата "
        '=========================
        rst = con.Execute(Command1)
        i =  4 
        Do Until rst.EOF
            Kolonka =  1 
            Do Until Kolonka > rst.Fields.Count
                ExcelBook.Worksheets().Item( 1 ).Cells(i, Kolonka).Value = rst.Fields(Kolonka -  1 ).value.ToString
                Kolonka = Kolonka +  1 
            Loop
            i = i +  1 
            rst.MoveNext()
        Loop

        Try
            rst.Close()
            con.Close()
        Catch ex As Exception
        End Try
        '------------------------------------------
        Dim ExcelFileName As String
        ExcelFileName = Now().Day.ToString + "." + Now().Month.ToString + "." + Now().Year.ToString
        ExcelBook.SaveAs(Root + "OUT1\" + ExcelFileName + ".xls")
        ExcelBook.SaveAs(Root + "Archive\" + ExcelFileName + ".xls")
        Shell(Root + "out.bat")
        ExcelBook.Close()
        ExcelObj.Quit()
        ExcelBook = Nothing
        ExcelObj = Nothing
    End Sub