Адаптация макроса Excel для запуска из приложения Access

Set appExcel = Excel.Application
appExcel.Visible = True

Dim wb As Workbook
Set wb = appExcel.Workbooks.Add
Set sh = wb.Worksheets("CheckBG")
With sh ' работаем с листом
   .Cells(1, 1).Value = "ОК" ' пишем в 1-ю ячейку
End With

 Set appExcel = Excel.Application
appExcel.Visible = True
            Dim wb As Workbook
Set wb = appExcel.Workbooks.Add
Set sh = wb.Worksheets("CheckBG")
With sh 
   .Cells(1, 1).Value = "ОК" 
End With

Dim appExcel As Excel.Application, sh As Worksheet, rng As Range
Dim rst As DAO.Recordset
Set appExcel = Excel.Application
appExcel.Visible = True
Dim wb As Workbook
Set wb = appExcel.Workbooks.Add
Set sh = wb.Worksheets(1)
With sh
   Set rng = .Range("A1:B5") ' диапазон вставки
End With
sq = CurrentDb.QueryDefs("CheckBG").sql ' присвоить текст запроса
Set rst = CurrentDb.OpenRecordset(sq) ' создать запрос
Call rng.CopyFromRecordset(rst)

sq = CurrentDb.QueryDefs("CheckBG").sql ' присвоить текст запроса
Set rst = CurrentDb.OpenRecordset(sq)

Set rst = CurrentDb.OpenRecordset("CheckBG")

       Dim rs As New ADODB.Recordset, strSQL As String
             strSQL = CurrentDb.QueryDefs("CheckBG").sql                 
             rs.Open strSQL, CurrentProject.Connection,3,3

Dim appExcel As Excel.Application, sh As Worksheet, rng As Range, mypath As String
    mypath = CurrentProject.Path & "\Ïðîâåðêà.xls" ' ïóòü ê ôàéëó â ïàïêå ðîäèòåëÿ
    mysheet = "CheckBG" ' èìÿ ëèñòà
    DoCmd.OutputTo acOutputQuery, mysheet, "Excel 97 - Excel 2003 Workbook (*.xls)", mypath, 1 ' çàïèñü ðåçóëüòàòà çàïðîñà â ôàéë Excel
    Set appExcel = GetObject(, "Excel.Application") ' ïðèñâîèòü îáúåêò Excel
    Set sh = appExcel.Sheets(mysheet) ' ïðèñâîèòü ññûëêó íà ëèñò
    sh.Visible = True ' cäåëàòü âèäèìûì
    appExcel.WindowState = xlMinimized ' скрыть в трей
    n = sh.Rows.Count ' ïîäñ÷¸ò ñòðîê
    With sh ' ðàáîòàåì ñ ëèñòîì
        'Count = Worksheets(mysheet).Cells(Rows.Count, 1).End(xlUp).Row 'ïîäñ÷¸ò ñòðîê â ôàéëå Excel VBA
        For i = 2 To n
          If .Cells(i, 1).Value <> 0 And .Cells(i, 11).Value <> .Cells(i, 12).Value Then ' ñðàâíè çíà÷åíèÿ
             Set rng = .Range(.Cells(i, 1), .Cells(i, 20))  ' ïðèñâîèòü ññûëêó íà äèàïàçîí
             With rng.Interior ' ðàáîòàåì ñ ìåòîäîì Interior äèàïàçîíà
                .ColorIndex = 46
                .Pattern = xlSolid
             End With
             End If
             Next i
     End With
     MsgBox "Ãîòîâî"