用vba实现将记录集输出到Excel模板

admin VBA

2023-12-05 0 777

复制代码代码如下:\’************************************************ \’**函数名称:ExportTempletToExcel \’**函数功能:将记录集输出到Excel模板 \’**参数说明: \’**strExcelFile要保存的Excel文件 \’**strSQL查询语句，就是要导出哪些内容 \’**strSheetName工作表名称 \’**adoConn已经打开的数据库连接 \’**函数返回: \’**Boolean类型 \’**True成功导出模板 \’**False失败 \’**参考实例: \’**CallExportTempletToExcel(c:\\\\text.xls,查询语句,工作表1,adoConn) \’************************************************ PrivateFunctionExportTempletToExcel(ByValstrExcelFileAsString,_ ByValstrSQLAsString,_ ByValstrSheetNameAsString,_ ByValadoConnAsObject)AsBoolean DimadoRtAsObject DimlngRecordCountAsLong\’记录数 DimintFieldCountAsInteger\’字段数 DimstrFieldsAsString\’所有字段名 DimiAsInteger DimexlApplicationAsObject\’Excel实例 DimexlBookAsObject\’Excel工作区 DimexlSheetAsObject\’Excel当前要操作的工作表 OnErrorGoToLocalErr Me.MousePointer=vbHourglass \’//创建ADO记录集对象 SetadoRt=CreateObject(ADODB.Recordset) WithadoRt .ActiveConnection=adoConn .CursorLocation=3\’adUseClient .CursorType=3\’adOpenStatic .LockType=1\’adLockReadOnly .Source=strSQL .Open If.EOFAnd.BOFThen ExportTempletToExcel=False Else \’//取得记录总数，+1是表示还有一行字段名名称信息 lngRecordCount=.RecordCount+1 intFieldCount=.Fields.Count-1 Fori=0TointFieldCount \’//生成字段名信息（vbTab在Excel里表示每个单元格之间的间隔） strFields=strFields&.Fields(i).Name&vbTab Next \’//去掉最后一个vbTab制表符 strFields=Left$(strFields,Len(strFields)-Len(vbTab)) \’//创建Excel实例 SetexlApplication=CreateObject(Excel.Application) \’//增加一个工作区 SetexlBook=exlApplication.Workbooks.Add \’//设置当前工作区为第一个工作表（默认会有3个） SetexlSheet=exlBook.Worksheets(1) \’//将第一个工作表改成指定的名称 exlSheet.Name=strSheetName \’//清除“剪切板” Clipboard.Clear \’//将字段名称复制到“剪切板” Clipboard.SetTextstrFields \’//选中A1单元格 exlSheet.Range(A1).Select \’//粘贴字段名称 exlSheet.Paste \’//从A2开始复制记录集 exlSheet.Range(A2).CopyFromRecordsetadoRt \’//增加一个命名范围，作用是在导入时所需的范围 exlApplication.Names.AddstrSheetName,=&strSheetName&!$A$1:$&_ uGetColName(intFieldCount+1)&$&lngRecordCount \’//保存Excel文件 exlBook.SaveAsstrExcelFile \’//退出Excel实例 exlApplication.Quit ExportTempletToExcel=True EndIf \’adStateOpen=1 If.State=1Then .Close EndIf EndWith LocalErr: \’********************************************* \’**释放所有对象 \’********************************************* SetexlSheet=Nothing SetexlBook=Nothing SetexlApplication=Nothing SetadoRt=Nothing \’********************************************* IfErr.Number<>0Then Err.Clear EndIf Me.MousePointer=vbDefault EndFunction \’//取得列名 PrivateFunctionuGetColName(ByValintNumAsInteger)AsString DimstrColNamesAsString DimstrReturnAsString \’//通常字段数不会太多，所以到26*3目前已经够了。 strColNames=A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,&_ AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR,AS,AT,AU,AV,AW,AX,AY,AZ,&_ BA,BB,BC,BD,BE,BF,BG,BH,BI,BJ,BK,BL,BM,BN,BO,BP,BQ,BR,BS,BT,BU,BV,BW,BX,BY,BZ strReturn=Split(strColNames,,)(intNum-1) uGetColName=strReturn EndFunction

您可能感兴趣的文章: