VB将数据导出到EXCEL.doc

* VB将数据导出到EXCEL,没有安装EXCEL的一样也可以导出.* 调用方式: s_Export2Excel(Ado.Recordset) 或 s_Export2Excel(Rds.RecordSet)* 支持 Rds 与 Ado 的记录导出*得到所有数据类型,有些数据类型EXCEL不支持,已经替换掉Public Function f_FieldType$(ByVal sType&) Dim iRe$ Select Case sType Case 2, 3, 20 iRe = int Case 5 iRe = float Case 6 iRe = money Case 131 iRe = numeric Case 4 iRe = real Case 128 iRe = binary Case 204 iRe = varbinary Case 11 iRe = bit Case 129, 130 iRe = char Case 17, 72, 131, 200, 202, 204 iRe = varchar Case 201, 203 iRe = text Case 7, 135 iRe = datetime Case 205 iRe = image Case 128 iRe = timestamp End Select f_FieldType = iReEnd Function导出ADO记录集到EXCELPublic Function f_Export2Excel(ByVal sRecordSet As ADODB.Recordset, ByVal sExcelFileName$ _ , Optional ByVal sTableName$, Optional ByVal sOverExist As Boolean = False) As Boolean On Error GoTo lbErr Dim iConcStr, iSql$, iFdlist$, iDB As ADODB.Connection Dim iI&, iFdType$, j, TmpField, FileName Dim iRe As Boolean 检查文件名 If Dir(sExcelFileName) Then If sOverExist Then Kill sExcelFileName Else iRe = False GoTo lbexit End If End If 生成创建表的SQL语句 With sRecordSet For iI = 0 To .Fields.Count - 1 iFdType = f_FieldType(.Fields(iI).Type) Select Case iFdType Case char , varchar , nchar , nvarchar , varbinary If .Fields(iI).DefinedSize 255 Then iSql = iSql & , & .Fields(iI).Name & text Else iSql = iSql & , & .Fields(iI).Name & & iFdType & _ ( & .Fields(iI).DefinedSize & ) End If Case image Case Else iSql = iSql & , & .Fields(iI).Name & & iFdType End Select Next If sTableName = Then sTableName = .Source iSql = create table & sTableName & ( & Mid(iSql, 2) & ) End With 数据库连接字符串 iConcStr = DRIVER=Microsoft Excel Driver (*.xls);DSN= ;FIRSTROWHASNAMES=1;READONLY=FALSE; & _ CREATE_DB= & sExcelFileName & ;DBQ= & sExcelFileName 创建Excel文件,并创建表 Set iDB = New ADODB.Connection iDB.Open iConcStr iDB.Execute iSql 插入数据 With sRecordSet .MoveFirst While .EOF = False iSql = iFdlist = For iI = 0 To .Fields.Count - 1 iFdType = f_FieldType(.Fields(iI).Type) If iFdType image And IsNull(.Fields(iI).Value) = False Then iFdlist = iFdlist & , & .Fields(iI).Name & Select Case iFdType Case char , varchar , nchar , nvarchar , text iSql = iSql & , & .Fields(iI).Value & Case datetime iSql = iSql & ,# & .Fields(iI).Value & # Case image Case Else iSql = iSql & , & .Fields(iI).Value End Select End If Next iSql = insert into & sTableName & ( & _ Mid(iFdlist, 2) & ) values( & Mid(iSql, 2) & ) iDB.Execute iSql .MoveNext Wend End With 处理完毕,关闭数据库 iDB.Close Set iDB = Nothing MsgBox 已经将数据保存到 & sExcelFileName & , 64 iRe = Tr