xls_list.asp

客户管理模块：随着计算机的普及和网络的迅猛发展

<!--#include file="Connections/EmpMain.asp" -->
<!--#include file="EmpMain_CheckRight.asp"-->
<%

Dim objExcel 
Dim ExcelPath 
dim savename
dim xlsrs
Set xlsrs = Server.CreateObject("ADODB.Recordset")
xlsrs.ActiveConnection = MM_EmpMain_STRING
xlsrs.Source = "SELECT id, 省份, 联系人, 公司名称, 职务, 联系电话,客户等级 FROM kufu   order by id desc"

xlsrs.CursorType = 0
xlsrs.CursorLocation = 2
xlsrs.LockType = 1
xlsrs.Open()

savename="1234"
ExcelPath =   SaveName & ".xls"
Set objExcel = New ExcelGen 
objExcel.RowOffset = 1 
objExcel.ColumnOffset = 1 
objExcel.GenerateWorksheet( xlsrs) 
if objExcel.SaveWorksheet(Server.MapPath(ExcelPath))  then
response.write("生成数据成功，<a href=1234.xls>点击下载</a>&nbsp;&nbsp;&nbsp;<a href=javascript:window.history.back(-1)>返回</a>")
else
response.write("生成数据出错！<a href=javascript:window.history.back(-1)>返回</a>")
end if
xlsrs.close
set  xlsrs=nothing
Class ExcelGen 
Private objSpreadsheet 
Private iColOffset 

Private iRowOffset 
Sub Class_Initialize() 
Set objSpreadsheet = Server.CreateObject("OWC.Spreadsheet") 
iRowOffset = 2 
iColOffset = 2 
End Sub 

Sub Class_Terminate() 
Set objSpreadsheet = Nothing 'Clean up 
End Sub 

Public Property Let ColumnOffset(iColOff) 
If iColOff > 0 then 
iColOffset = iColOff 
Else 
iColOffset = 2 
End If 
End Property 

Public Property Let RowOffset(iRowOff) 
If iRowOff > 0 then 
iRowOffset = iRowOff 
Else 
iRowOffset = 2 
End If 
End Property
 Sub GenerateWorksheet(EmpList) 
'Populates the Excel worksheet based on a Recordset's contents 
'Start by displaying the titles 
If EmpList.EOF then Exit Sub 
Dim objField, iCol, iRow 
iCol = iColOffset 
iRow = iRowOffset 
For Each objField in EmpList.Fields 
objSpreadsheet.Cells(iRow, iCol).Value =objField.Name 
objSpreadsheet.Columns(iCol).AutoFitColumns 
'设置Excel表里的字体 
objSpreadsheet.Cells(iRow, iCol).Font.Bold = True 
objSpreadsheet.Cells(iRow, iCol).Font.Italic = False 
objSpreadsheet.Cells(iRow, iCol).Font.Size = 10 
objSpreadsheet.Cells(iRow, iCol).Halignment = 2 '居中 
iCol = iCol + 1 
Next 'objField 
'Display all of the data 
Do While Not EmpList.EOF 
iRow = iRow + 1 
iCol = iColOffset 

'For Each objField in EmpList.Fields
'If IsNull(objField.Value) then 
'objSpreadsheet.Cells(iRow, iCol).Value = "" 
'Else 
objSpreadsheet.Cells(iRow, 1).Value =EmpList.Fields.Item("id").Value'objField.value 
objSpreadsheet.Cells(iRow, 2).Value =EmpList.Fields.Item("省份").Value'objField.value 
objSpreadsheet.Cells(iRow, 3).Value =EmpList.Fields.Item("联系人").Value'objField.value 
objSpreadsheet.Cells(iRow, 4).Value =EmpList.Fields.Item("公司名称").Value'objField.value 
objSpreadsheet.Cells(iRow, 5).Value =EmpList.Fields.Item("职务").Value'objField.value 
objSpreadsheet.Cells(iRow, 6).Value =EmpList.Fields.Item("联系电话").Value'objField.value 
objSpreadsheet.Cells(iRow, 7).Value =EmpList.Fields.Item("客户等级").Value'objField.value 

objSpreadsheet.Columns(iCol).AutoFitColumns 
objSpreadsheet.Cells(iRow, iCol).Font.Bold = False 
objSpreadsheet.Cells(iRow, iCol).Font.Italic = False 
objSpreadsheet.Cells(iRow, iCol).Font.Size = 10 
'End If 
iCol = iCol + 1 
'Next 'objField 
EmpList.MoveNext 
Loop 
End Sub 
Function SaveWorksheet(strFileName) 

'Save the worksheet to a specified filename 
On Error Resume Next 
Call objSpreadsheet.ActiveSheet.Export(strFileName, 0) 
SaveWorksheet = (Err.Number = 0) 
End Function 
End Class
 

%>