|
|
方法挺多的，先把记录集弄到控件上，然后用控件的属性一条一条导到EXCEL 里，这种方法，如果数据量小的话还行，数据量大的话……有次无聊弄了个70列10000行的表格导了那么一下子，不能怪俺机器配置不好，因为客户的机器配置不一定比我的好，居然用了近一个钟头。这种方法不能用在数据量大的地方，用了会挨骂的。
也用过ADOX导过，速度不赖，但总觉得怪怪的，具体怪到哪了，我也不知道。
下面写个ADO的一个方法，速度不赖，代码也不太拉杂，大家如果有兴趣的话可以看看。
定义一个数组
Public arrExl(255) As String
'定义Excel列表头的，据我所知，2003版本的EXCEL好像默认最大是256列,也就是到了IV列，下面是定义的
'数组，各位如果为了省空间可以自己删减该数组的大小。为了这个数组，我可是折腾了半天呀，也算是
'个资源。
Public Function LoadArrExl() As Boolean
On Error GoTo ErrMsg
LoadArrFild = False
arrExl(0) = "a"
arrExl(1) = "b"
arrExl(2) = "c"
arrExl(3) = "d"
arrExl(4) = "e"
arrExl(5) = "f"
arrExl(6) = "g"
arrExl(7) = "h"
arrExl(8) = "i"
arrExl(9) = "j"
arrExl(10) = "k"
arrExl(11) = "l"
arrExl(12) = "m"
arrExl(13) = "n"
arrExl(14) = "o"
arrExl(15) = "p"
arrExl(16) = "q"
arrExl(17) = "r"
arrExl(18) = "s"
arrExl(19) = "t"
arrExl(20) = "u"
arrExl(21) = "v"
arrExl(22) = "w"
arrExl(23) = "x"
arrExl(24) = "y"
arrExl(25) = "z"
arrExl(26) = "aa"
arrExl(27) = "ab"
arrExl(28) = "ac"
arrExl(29) = "ad"
arrExl(30) = "ae"
arrExl(31) = "af"
arrExl(32) = "ag"
arrExl(33) = "ah"
arrExl(34) = "ai"
arrExl(35) = "aj"
arrExl(36) = "ak"
arrExl(37) = "al"
arrExl(38) = "am"
arrExl(39) = "an"
arrExl(40) = "ao"
arrExl(41) = "ap"
arrExl(42) = "aq"
arrExl(43) = "ar"
arrExl(44) = "as"
arrExl(45) = "at"
arrExl(46) = "au"
arrExl(47) = "av"
arrExl(48) = "aw"
arrExl(49) = "ax"
arrExl(50) = "ay"
arrExl(51) = "az"
arrExl(52) = "ba"
arrExl(53) = "bb"
arrExl(54) = "bc"
arrExl(55) = "bd"
arrExl(56) = "be"
arrExl(57) = "bf"
arrExl(58) = "bg"
arrExl(59) = "bh"
arrExl(60) = "bi"
arrExl(61) = "bj"
arrExl(62) = "bk"
arrExl(63) = "bl"
arrExl(64) = "bm"
arrExl(65) = "bn"
arrExl(66) = "bo"
arrExl(67) = "bp"
arrExl(68) = "bq"
arrExl(69) = "br"
arrExl(70) = "bs"
arrExl(71) = "bt"
arrExl(72) = "bu"
arrExl(73) = "bv"
arrExl(74) = "bw"
arrExl(75) = "bx"
arrExl(76) = "by"
arrExl(77) = "bz"
arrExl(78) = "ca"
arrExl(79) = "cb"
arrExl(80) = "cc"
arrExl(81) = "cd"
arrExl(82) = "ce"
arrExl(83) = "cf"
arrExl(84) = "cg"
arrExl(85) = "ch"
arrExl(86) = "ci"
arrExl(87) = "cj"
arrExl(88) = "ck"
arrExl(89) = "cl"
arrExl(90) = "cm"
arrExl(91) = "cn"
arrExl(92) = "co"
arrExl(93) = "cp"
arrExl(94) = "cq"
arrExl(95) = "cr"
arrExl(96) = "cs"
arrExl(97) = "ct"
arrExl(98) = "cu"
arrExl(99) = "cv"
arrExl(100) = "cw"
arrExl(101) = "cx"
arrExl(102) = "cy"
arrExl(103) = "cz"
arrExl(104) = "da"
arrExl(105) = "db"
arrExl(106) = "dc"
arrExl(107) = "dd"
arrExl(108) = "de"
arrExl(109) = "df"
arrExl(110) = "dg"
arrExl(111) = "dh"
arrExl(112) = "di"
arrExl(113) = "dj"
arrExl(114) = "dk"
arrExl(115) = "dl"
arrExl(116) = "dm"
arrExl(117) = "dn"
arrExl(118) = "do"
arrExl(119) = "dp"
arrExl(120) = "dq"
arrExl(121) = "dr"
arrExl(122) = "ds"
arrExl(123) = "dt"
arrExl(124) = "du"
arrExl(125) = "dv"
arrExl(126) = "dw"
arrExl(127) = "dx"
arrExl(128) = "dy"
arrExl(129) = "dz"
arrExl(130) = "ea"
arrExl(131) = "eb"
arrExl(132) = "ec"
arrExl(133) = "ed"
arrExl(134) = "ee"
arrExl(135) = "ef"
arrExl(136) = "eg"
arrExl(137) = "eh"
arrExl(138) = "ei"
arrExl(139) = "ej"
arrExl(140) = "ek"
arrExl(141) = "el"
arrExl(142) = "em"
arrExl(143) = "en"
arrExl(144) = "eo"
arrExl(145) = "ep"
arrExl(146) = "eq"
arrExl(147) = "er"
arrExl(148) = "es"
arrExl(149) = "et"
arrExl(150) = "eu"
arrExl(151) = "ev"
arrExl(152) = "ew"
arrExl(153) = "ex"
arrExl(154) = "ey"
arrExl(155) = "ez"
arrExl(156) = "fa"
arrExl(157) = "fb"
arrExl(158) = "fc"
arrExl(159) = "fd"
arrExl(160) = "fe"
arrExl(161) = "ff"
arrExl(162) = "fg"
arrExl(163) = "fh"
arrExl(164) = "fi"
arrExl(165) = "fj"
arrExl(166) = "fk"
arrExl(167) = "fl"
arrExl(168) = "fm"
arrExl(169) = "fn"
arrExl(170) = "fo"
arrExl(171) = "fp"
arrExl(172) = "fq"
arrExl(173) = "fr"
arrExl(174) = "fs"
arrExl(175) = "ft"
arrExl(176) = "fu"
arrExl(177) = "fv"
arrExl(178) = "fw"
arrExl(179) = "fx"
arrExl(180) = "fy"
arrExl(181) = "fz"
arrExl(182) = "ga"
arrExl(183) = "gb"
arrExl(184) = "gc"
arrExl(185) = "gd"
arrExl(186) = "ge"
arrExl(187) = "gf"
arrExl(188) = "gg"
arrExl(189) = "gh"
arrExl(190) = "gi"
arrExl(191) = "gj"
arrExl(192) = "gk"
arrExl(193) = "gl"
arrExl(194) = "gm"
arrExl(195) = "gn"
arrExl(196) = "go"
arrExl(197) = "gp"
arrExl(198) = "gq"
arrExl(199) = "gr"
arrExl(200) = "gs"
arrExl(201) = "gt"
arrExl(202) = "gu"
arrExl(203) = "gv"
arrExl(204) = "gw"
arrExl(205) = "gx"
arrExl(206) = "gy"
arrExl(207) = "gz"
arrExl(208) = "ha"
arrExl(209) = "hb"
arrExl(210) = "hc"
arrExl(211) = "hd"
arrExl(212) = "he"
arrExl(213) = "hf"
arrExl(214) = "hg"
arrExl(215) = "hh"
arrExl(216) = "hi"
arrExl(217) = "hj"
arrExl(218) = "hk"
arrExl(219) = "hl"
arrExl(220) = "hm"
arrExl(221) = "hn"
arrExl(222) = "ho"
arrExl(223) = "hp"
arrExl(224) = "hq"
arrExl(225) = "hr"
arrExl(226) = "hs"
arrExl(227) = "ht"
arrExl(228) = "hu"
arrExl(229) = "hv"
arrExl(230) = "hw"
arrExl(231) = "hx"
arrExl(232) = "hy"
arrExl(233) = "hz"
arrExl(234) = "ia"
arrExl(235) = "ib"
arrExl(236) = "ic"
arrExl(237) = "id"
arrExl(238) = "ie"
arrExl(239) = "if"
arrExl(240) = "ig"
arrExl(241) = "ih"
arrExl(242) = "ii"
arrExl(243) = "ij"
arrExl(244) = "ik"
arrExl(245) = "il"
arrExl(246) = "im"
arrExl(247) = "in"
arrExl(248) = "io"
arrExl(249) = "ip"
arrExl(250) = "iq"
arrExl(251) = "ir"
arrExl(252) = "is"
arrExl(253) = "it"
arrExl(254) = "iu"
arrExl(255) = "iv"
LoadArrFild = True
Exit Function
ErrMsg:
MsgBox Err.Description, vbInformation, "系统提示"
End Function
'----累死我了，本来想弄个循环来填充这个数组，想想，空间都大那么多，时间上咱就别装大方了，直接一
'条一条灌吧。呃～不过上面的代码耍了花招，用EXCEL的编辑功能，呵呵。
'----------------------------------------------------------------------------
'导出EXCEL的函数
'作者:yyhust1
Public Function ImportToExcel(Res As ADODB.Recordset) as Boolean
Dim myexcel As New Excel.Application
Dim mybook As New Excel.Workbook
Dim mysheet As New Excel.Worksheet
Dim i As Integer
On Error GoTo Emsg
ImportToExcel=False
Set mybook = myexcel.Workbooks.Add '添加一个新的BOOK
Set mysheet = mybook.Worksheets(1)
'关键就是下面这一句，用了CopyFromRecordset方法
mysheet.Cells.CopyFromRecordset Res
'下面是添加列表头,如果不需要的话可以注释掉。
myexcel.Rows("1:1").Select
myexcel.Selection.Insert Shift:=xlDown
For i = 0 To Res.Fields.Count - 1
myexcel.Range(arrExl(i) & "1").Select
myexcel.ActiveCell.FormulaR1C1 = Res.Fields(i).Name
Next
myexcel.Visible = True
ImportToExcel=True
Set mysheet = Nothing
Res.Close
Set Res = Nothing
Emsg:
MsgBox Err.Description, vbInformation, "系统提示"
Res.Close
Set Res = Nothing
Set mysheet = Nothing
End Function
好了，大家试试吧，速度不赖的。建议如果有一个报表是一个纯记录集(无二次数据处理的情况下)，大家导EXCEL时就用这个函数吧。 |
|
|
