在WIN7+OFFICE2003下导出数据到EXCEL文件时失败，如何解决

在WIN7+OFFICE2003下导出数据到EXCEL文件时失败，如何解决具体导出代码如下：
Public Function ExporToExcel(strOpen As String)
On Error GoTo Errc
Dim Rs_Data As New ADODB.Recordset
Dim Irowcount As Integer
Dim Icolcount As Integer
    Dim xlApp As New Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim xlQuery As Excel.QueryTable
    
    With Rs_Data
        If .State = adStateOpen Then
            .Close
        End If
        .ActiveConnection = Conn
        .CursorLocation = adUseClient
        .CursorType = adOpenStatic
        .LockType = adLockReadOnly
        .Source = strOpen
        .Open
    End With
    With Rs_Data
        If .RecordCount < 1 Then
            MsgBox ("没有记录!")
            Exit Function
        End If
        '记录总数
        Irowcount = .RecordCount
        '字段总数
        Icolcount = .Fields.Count
    End With
    
     Set xlApp = CreateObject("Excel.Application")  ‘运行到此处时 直接提示“ActiveX 部件不能创建对象”   
    Set xlBook = Nothing
    Set xlSheet = Nothing
    Set xlBook = xlApp.Workbooks().Add
    Set xlSheet = xlBook.Worksheets("sheet1")
     xlApp.Visible = True
    
    '添加查询语句，导入EXCEL数据
    Set xlQuery = xlSheet.QueryTables.Add(Rs_Data, xlSheet.Range("a1"))
    
    With xlQuery
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = True
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
    End With
    
    xlQuery.FieldNames = True '显示字段名
    xlQuery.Refresh
    
    With xlSheet
        .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Name = "黑体"
        .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Size = 10
        '设标题为黑体字
  '     .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Bold = True
        '标题字体加粗
        .Range(.Cells(1, 1), .Cells(Irowcount + 1, Icolcount)).Borders.LineStyle = xlContinuous
        '设表格边框样式
    End With
    
    With xlSheet.PageSetup
        .Orientation = xlLandscape
    End With
   
    xlApp.Application.Visible = True
    Set xlApp = Nothing '"交还控制给Excel
    Set xlBook = Nothing
    Set xlSheet = Nothing
Exit Function
Errc:
   MsgBox ERR.Description
End Function运行到  Set xlApp = CreateObject("Excel.Application")  ‘运行到此处时 直接提示“ActiveX 部件不能创建对象”   
在XP+OFFICE2003的环境下，同一程序，同样操作，导出数据到EXCEL文件，无异常。请问如何解决。