Excel: VB -> Delphi Conversion

I basically want this function converted from VB to Delphi. The data from the VB version is coming from SQL, the delphi
one will come from a TList. so that part can be ignored or replaced with something like MyList(list[i]).Item1);

Public Sub ExportTQC(intMode As Integer)
On Error GoTo HandleError 'Resume Next
'intMode = 1 All Info
'intMode = 2 AD Info...no cell numbers
'intMode = 2 All Info sort by dept

Dim rst As ADODB.Recordset

Dim sSQL As String
Dim sMsg As String

Dim strFax() As String
Dim strConf() As String
Dim strOther() As String

Dim appExcel As Excel.Application
Dim wbkNew As Excel.Workbook
Dim wksNew As Excel.Worksheet

Dim iCounter As Long
Dim iFldCount As Long
Dim i As Integer, j As Long
Dim lColumnCount As Long

Dim sRootPath As String
Dim sFileName As String
Dim sScriptFileName As String
Dim sExcelFileName As String
Dim sExcelFileAndPath As String
Dim sSQLString As String

Dim strRange As String
Dim strEndColumn As String
Dim lBackcolor As Long
Const vbLightBlue = 16777164
Const xlLightBlue = 37

    Set appExcel = Excel.Application
    Set wbkNew = appExcel.Workbooks.Add
    Set wksNew = appExcel.Worksheets("Sheet1")
   
    wbkNew.Sheets("Sheet1").Name = "TQC Directory"
    Application.DisplayAlerts = False
    wbkNew.Sheets("Sheet2").Delete
    wbkNew.Sheets("Sheet3").Delete
    Application.DisplayAlerts = True
   
    wbkNew.Protect "tqc123", True, False
   
    Select Case intMode
        Case 1
            sExcelFileAndPath = iQSettings.AllStaff & "TQC Directory.xls"
            lColumnCount = 6
            strEndColumn = "G"
            sSQLString = "SP_GetTQCActive"
        Case 2
            sExcelFileAndPath = iQSettings.AllStaff & "TQC DirectoryAD.xls"
            lColumnCount = 5
            strEndColumn = "F"
            sSQLString = "SP_GetTQCActiveAD"
       Case 3
            sExcelFileAndPath = iQSettings.AllStaff & "TQC DirectoryDept.xls"
            lColumnCount = 6
            strEndColumn = "G"
            sSQLString = "usp_GetTQCActiveByDept"
    End Select
   
    Set rst = CreateRecordSet(sSQLString)
   
    iFldCount = rst.Fields.Count

    With wksNew
        .Cells.Font.Name = "Arial"
        .Cells.Font.Size = 8
        .Cells.Font.Strikethrough = False
        .Cells.Font.Superscript = False
        .Cells.Font.Subscript = False
        .Cells.Font.OutlineFont = False
        .Cells.Font.Shadow = False
        .Cells.Font.Underline = xlUnderlineStyleNone
        .Cells.Font.ColorIndex = xlAutomatic
       
        .Rows("2:2").Select
        ActiveWindow.FreezePanes = True
       
        ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"
        ActiveSheet.PageSetup.PrintTitleColumns = ""

        .Rows("1:1").Select
        Selection.Font.Bold = True
       
        'ActiveSheet.PageSetup.PrintArea = ""
        .PageSetup.LeftHeader = "TQC Directory"
        .PageSetup.CenterHeader = ""
        .PageSetup.RightHeader = ""
        .PageSetup.LeftFooter = "&D"
        .PageSetup.CenterFooter = ""
        .PageSetup.RightFooter = "&P of &N"
           
        .PageSetup.LeftMargin = 48
        .PageSetup.RightMargin = 36
        .PageSetup.TopMargin = 36
        .PageSetup.BottomMargin = 54
        .PageSetup.HeaderMargin = 18
        .PageSetup.FooterMargin = 18
           
        .PageSetup.PrintHeadings = False
        .PageSetup.PrintGridlines = False
        .PageSetup.PrintComments = xlPrintNoComments
        .PageSetup.PrintQuality = 600
        .PageSetup.CenterHorizontally = True
        .PageSetup.CenterVertically = False
        .PageSetup.Draft = False
        .PageSetup.FirstPageNumber = xlAutomatic
        .PageSetup.Order = xlDownThenOver
        .PageSetup.BlackAndWhite = False
        .PageSetup.Zoom = 90
        .PageSetup.Orientation = xlLandscape
       
       
        ' Create column headers
        For i = 0 To lColumnCount
'            If intMode = 2 And i = 3 Then
'                .Cells(1, i + 1).Value = ""
'                GoTo SkipToNext
'            End If
            If InStr(1, rst.Fields(i).Name, "zip") > 0 Then
                .Cells.NumberFormat = "@"
                .Cells(1, i + 1).Value = Format(CStr(rst.Fields(i).Name), "00000")
            Else
                .Cells.NumberFormat = "@"
                .Cells(1, i + 1).Value = rst.Fields(i).Name
            End If
'SkipToNext:
        Next

        strRange = "A1:" & strEndColumn & "1"
       
        .Range(strRange).Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Range(strRange).Borders(xlEdgeBottom).Weight = xlThin
        .Range(strRange).Borders(xlEdgeBottom).ColorIndex = xlAutomatic

        ' Data starts on 3rd row
        j = 2
   
        ' Loop through recordset adding rows to Excel
        Do Until rst.EOF
       
            strRange = "A" & CStr(j) & ":" & strEndColumn & CStr(j)
           
            lBackcolor = xlLightBlue
            If rst.Fields("FlagRecord") = 0 Then lBackcolor = xlNone
            .Range(strRange).Interior.ColorIndex = lBackcolor
           
            If (j - 1) Mod 5 = 0 Then
                .Range(strRange).Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Range(strRange).Borders(xlEdgeBottom).Weight = xlThin
                .Range(strRange).Borders(xlEdgeBottom).ColorIndex = xlAutomatic
            Else
                .Range(strRange).Borders(xlEdgeBottom).LineStyle = xlNone
            End If
           
            For i = 0 To lColumnCount
'                If intMode = 2 And i = 3 Then
'                    .Cells(j, i + 1).Value = ""
'                Else
                    .Cells(j, i + 1).Value = rst.Fields(i).Value
'                End If
            Next
                   
            j = j + 1
            rst.MoveNext
        Loop
       
        .Cells.Select
        .Cells.EntireColumn.AutoFit
        .Range("A1").Select
       
'======================
'set up special numbers
'======================
Dim intX As Integer
Dim intRootJ As Integer
       
        j = j + 1
        .Cells(j, 1) = "FAX NUMBERS"
        .Cells(j, 4) = "CONFERENCE ROOMS"
        .Cells(j, 6) = "OTHER NUMBERS"
       
        strRange = "A" & j & ":F" & j
        .Range(strRange).Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Range(strRange).Borders(xlEdgeBottom).Weight = xlThin
        .Range(strRange).Borders(xlEdgeBottom).ColorIndex = xlAutomatic
        .Range(strRange).Font.Bold = True
       
        intRootJ = j
        Set rst = New ADODB.Recordset
        Set rst = CreateRecordSet("SP_GetTQCSpecialNumbers 1") 'fax numbers
        ReDim strFax(rst.RecordCount)
        intX = 0
        Do While rst.EOF = False
            intX = intX + 1
            strFax(intX) = rst.Fields("string_label") & " " & rst.Fields("string")
            .Cells(j + intX, 1) = strFax(intX)
            rst.MoveNext
        Loop
               
        Set rst = New ADODB.Recordset
        Set rst = CreateRecordSet("SP_GetTQCSpecialNumbers 2") 'conf numbers
        ReDim strConf(rst.RecordCount)
        intX = 0
        Do While rst.EOF = False
            intX = intX + 1
            strConf(intX) = rst.Fields("string_label") & " " & rst.Fields("string")
            .Cells(j + intX, 4) = strConf(intX)
            rst.MoveNext
        Loop
               
        Set rst = New ADODB.Recordset
        Set rst = CreateRecordSet("SP_GetTQCSpecialNumbers 3") 'other numbers
        ReDim strOther(rst.RecordCount)
        intX = 0
        Do While rst.EOF = False
            intX = intX + 1
            strOther(intX) = rst.Fields("string_label") & " " & rst.Fields("string")
            .Cells(j + intX, 6) = strOther(intX)
            rst.MoveNext
        Loop
               
        .Protect Password:="tqc123", DrawingObjects:=False, Contents:=True, Scenarios:=False

    End With
   
    appExcel.Visible = True
   
On Error GoTo HandleError
   
    KillFile (sExcelFileAndPath)
    wbkNew.Protect "tqc123", True, False
    wbkNew.SaveAs FileName:=sExcelFileAndPath
ShowTQC:
    appExcel.DisplayFullScreen = True
    appExcel.DisplayFullScreen = False
    If Not wksNew Is Nothing Then
        wksNew.Select
    End If
KillObjects:
    Set rst = Nothing

    ' Cleanup Excel objects
    Set wksNew = Nothing
    Set wbkNew = Nothing
    Set appExcel = Nothing
Exit Sub

HandleError:
If Err.Number = 1004 Then
    MsgBox "The file cannot be copied to the network location. A user on the network has the file opened." & vbCr & "The TQC File needs to be saved manually by you.", vbOKOnly
    GoTo ShowTQC
Else
    MsgBox "The following error occured:" & vbCr & Err.Description & vbCr & Err.Number
End If
GoTo KillObjects

End Sub