VB生成EXCEL版本问题

Question

我的机器安装的是EXCEL2003，编译完后放到客户机上，客户机的是EXCEL2000，结果导出EXCEL出错。
代码是这样：Dim myapplication As excel.Application
Dim mybook As excel.WorkbookPrivate Sub toexcel(xlapp As Object, xlbook As Object, strOpen As String, ByVal k As Integer, cn As ADODB.Connection, depname As String)
k = k + 1
On Error GoTo errhandle
  Dim Rs_Data     As New ADODB.Recordset
  Dim Irowcount     As Integer
  Dim Icolcount     As Integer
            
          'Dim xlSheet     As excel.Worksheet
          'Dim xlQuery      As excel.QueryTable
          Dim xlSheet As Variant
          Dim xlQuery As Variant
          
          With Rs_Data
                  If .State = adStateOpen Then
                          .Close
                  End If
                  .ActiveConnection = cn
                  .CursorLocation = adUseClient
                  .CursorType = adOpenStatic
                  .LockType = adLockReadOnly
                  .Source = strOpen
                  .Open
          End With
          
          With Rs_Data
                  If .RecordCount < 1 Then
                          'MsgBox ("没有记录!")
                          'Exit Sub
                          Set xlSheet = Nothing
                          Set xlSheet = xlbook.Worksheets(k)
                          GoTo norecord
                  End If
                  '记录总数
                  Irowcount = .RecordCount
                  '字段总数
                  Icolcount = .Fields.Count
          End With
      Set xlSheet = Nothing
      Set xlSheet = xlbook.Worksheets(k)
      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.Bold = True
                  '标题字体加粗
                  .Range(.Cells(1, 1), .Cells(Irowcount + 1, Icolcount)).Borders.LineStyle = xlContinuous
                  '设表格边框样式
                  .Range(.Cells(1, 1), .Cells(Irowcount + 1, Icolcount)).VerticalAlignment = xlVAlignCenter
                  .Range(.Cells(1, 1), .Cells(Irowcount + 1, Icolcount)).HorizontalAlignment = xlVAlignCenter
                  .Range(.Cells(1, 1), .Cells(Irowcount + 1, Icolcount)).RowHeight = 20
                  '.Range(.Cells(1, 1), .Cells(Irowcount + 1, Icolcount)).EntireColumn.AutoFit
          End With
         
          With xlSheet.PageSetup
                  .LeftHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10单位：" & depname & ""
                  .CenterHeader = "&""楷体_GB2312,常规""" & mysheetName & " &14职工出勤累计"
                  .RightHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10制表日期：" & mydate & ""
                  '.LeftFooter = "&""楷体_GB2312,常规""&10制表人：" & Text2.Text & ""
                  .CenterFooter = "" & Chr(10) & "&""楷体_GB2312,常规""&10名称："
                  .RightFooter = "&""楷体_GB2312,常规""&10第&P页   共&N页"
                  
          End With
          xlSheet.PageSetup.PrintTitleRows = "a1"
          'xlSheet.Name = Rs_Data.Fields("工区名称")
norecord:  xlSheet.Name = depname
          'xlapp.Application.Visible = True
          'Set xlapp = Nothing           '"交还控制给Excel
          'Set xlbook = Nothing
          Set xlSheet = Nothing
 Exit Suberrhandle:
xlapp.Quit
Set xlbook = Nothing
Set xlapp = Nothing
End Sub如果要写的东西无关EXCEL版本
应该如何写？

Answer 1

干嘛不用 objExcel = CreateObject("Excel.Application") 这样就应该不会出现版本问题了
Public Sub SaveAsExcel(rsRecord As Recordset, xlsPath As String)
    Dim rs As New ADODB.Recordset
    Dim objExcel As Object
    Dim objBook As Object
    Dim objSheet As Object
    Dim rowCount As Long
    Dim colCount As Integer
    Dim j As Integer
    Dim i As Integer
    On Error GoTo Error1:
    Set objExcel = CreateObject("Excel.Application")
    Set objBook = objExcel.Workbooks.Add    MousePointer = vbHourglass
    Set objSheet = objBook.Worksheets(1)
    objSheet.Name = "业务数据信息"
    Set rs = rsRecord
    
    '快速导出方案
'  objSheet.Cells.CopyFromRecordset rs
'  objBook.SaveAs (xlsPath) '保存文件
'  Set rs = Nothing
'    objBook.Close
'    objExcel.Quit
'    Set objExcel = Nothing
'    MsgBox "数据已经全部导出"
'    MousePointer = vbDefault
'  Exit Sub
   
    colCount = rs.Fields.Count
    rowCount = rs.RecordCount    For i = 0 To colCount - 1
        objSheet.Cells(1, i + 1) = rs.Fields(i).Name
        objSheet.Cells(1, i + 1).Font.Bold = True
    Next    For j = 2 To rowCount + 1
        For i = 0 To colCount - 1
            If objSheet.Cells(1, i + 1) = "交易金额" Then
                objSheet.Cells(j, i + 1).NumberFormatLocal = "0.00_ "
                objSheet.Cells(j, i + 1) = Val(Trim(Replace(Replace(rs.Fields(i), Chr(10), ""), Chr(13), "")))
            Else
                objSheet.Cells(j, i + 1).NumberFormatLocal = "@"
                objSheet.Cells(j, i + 1) = CStr(Trim(Replace(Replace(rs.Fields(i), Chr(10), ""), Chr(13), "")))
            End If
        Next
        rs.MoveNext
    Next
    objSheet.Cells.Select
    objSheet.Cells.Columns.AutoFit
    objBook.SaveAs (xlsPath)
    Set rs = Nothing
    objBook.Close
    objExcel.Quit
    Set objExcel = Nothing
    MsgBox "数据已经全部导出"
    MousePointer = vbDefault
    Exit Sub
Error1:
    MousePointer = vbDefault
    MsgBox ERR.Description, vbCritical
    objBook.Close
    objExcel.Quit
    Set objExcel = Nothing
End Sub

Answer 2

[code=vb]
Dim xlSheet As Object
Dim xlQuery As Object
[code]

Answer 3

'Dim xlSheet     As excel.Worksheet
'Dim xlQuery      As excel.QueryTable
dim xlSheet as Object
dim xlQuery as Object