asp 如何动态获取 excel 工作表名

Set xlsconn = server.CreateObject("adodb.connection") 

set rs=server.CreateObject("adodb.recordset")

source1=server.mappath(replace(request.Form("aa"),"/","\"))

myConn_Xsl="Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&source1&";Extended Properties=Excel 8.0"

xlsconn.open myConn_Xsl

sql="select * from [aasa$]"

做了一个asp 上传excel导入到数据库的功能，
select * from [aasa$]
但是无法做出动态获取这个excel的工作表名（aasa），请问该如何做？工作表的名不一定是sheet1$，改如何动态获取？

还有个问题，asp导出excel生成的文件是用fso直接写制表符分隔文本的那种。虽然后缀是xls，但是不能在导入回去，后来发现的必须手动另存为xls文件才可以，请问有什么方法能直接保存正常的excel格式么？

10 个解决方案

#1

Set adox = CreateObject("ADOX.Catalog")
Set conn = CreateObject("ADODB.Connection")
conn.open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="& sExcelFilePath &";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""
adox.activeConnection = conn
for each table in adox.tables
if table.type="TABLE" then
>
<%=table.name %>
<%
end if
next
%>

#2

楼上正解。已经给出方案了。

#3

感谢，回复
第二个问题

asp导出excel生成的文件是用fso直接写制表符分隔文本的那种。虽然后缀是xls，但是不能在导入回去，后来发现的必须手动另存为xls文件才可以，请问有什么方法能直接保存正常的excel格式么？

谢谢

#4

跳过FSO导出 EXCEL，利用OWC组件导出EXCEL，也许可以。

#5

asp能用owc么？是需要安装什么么？谢谢

#6

安装OFFICE 2003 就有了。

#7

一些是部分代码，可以参考调用。
<%
Class ExcelExport
    Private objSpreadsheet
    Private iColOffset
    Private iRowOffset
'类初始化
    Private Sub Class_Initialize()
        Set objSpreadsheet = Server.CreateObject("OWC11.Spreadsheet")
        iRowOffset = 2
        iColOffset = 2
    End Sub
    '类销毁
    Private Sub Class_Terminate()
        Set objSpreadsheet = Nothing
    End Sub

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

    Public Property Let RowOffset(ByVal iRowOff)
        If iRowOff > 0 Then
            iRowOffset = iRowOff
        Else
            iRowOffset = 2
        End If
    End Property

    Public Sub GenerateWorksheet(ByVal objRs)
'填充基于一个记录集内容的Excel工作表
'首先显示的标题
        If objRs.EOF Then Exit Sub
        Dim objField,iCol,iRow,k
Dim strFk,strState,strCz
        iCol = iColOffset
        iRow = iRowOffset
        Dim ArrTitle
        ArrTitle = Split("自动编号|单据编号|姓名|联系电话|村名|镇名|毛重|皮重|净重|计量单位|单价|金额|填单人|过磅|监磅|质检员|是否付款|备注|付款人|制单人|青贮池编号|单位名称|付款时间|添加时间|添加时间具体到分秒|二次过磅时间|二次过磅状态|差价|冲账|身份证号码|公司|付款时间|单车耗时|农户编号","|")
        For i = 0 to UBound(ArrTitle)
            objSpreadsheet.Cells(iRow, iCol).Value = ArrTitle(i)
            objSpreadsheet.Columns(iCol).AutoFit
            '设置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).HorizontalAlignment = objSpreadsheet.Constants.xlHAlignCenter '居中
            iCol = iCol + 1
        Next
'字段显示结束
        '显示数据
        Do While objRs.EOF = False
            iRow = iRow + 1
            iCol = iColOffset
If objRs("Xh_Sffk") = True Then
strFk = "是"
Else
strFk = "否"
End If
If objRs("Xh_State") = 0 Then
strState = "没二次过磅"
Else
strState = "已二次过磅"
End If
If objRs("Xh_Cz") = 0 Then
strCz = "无冲账"
Else
strCz = "已冲账"
End If
objSpreadsheet.Cells(iRow, 1).Value = objRs("AutoId")
objSpreadsheet.Cells(iRow, 2).Value = objRs("Xh_Djbh")
objSpreadsheet.Cells(iRow, 3).Value = objRs("Xh_Xm")
objSpreadsheet.Cells(iRow, 4).Value = objRs("Xh_Lxdh")
objSpreadsheet.Cells(iRow, 5).Value = objRs("Xh_Cm")
objSpreadsheet.Cells(iRow, 6).Value = objRs("Xh_Zm")
objSpreadsheet.Cells(iRow, 7).Value = objRs("Xh_Mz")
objSpreadsheet.Cells(iRow, 8).Value = objRs("Xh_Pz")
objSpreadsheet.Cells(iRow, 9).Value = objRs("Xh_Jz")
objSpreadsheet.Cells(iRow, 10).Value = objRs("Xh_Jldw")
objSpreadsheet.Cells(iRow, 11).Value = objRs("Xh_Dj")
objSpreadsheet.Cells(iRow, 12).Value = objRs("Xh_Je")
objSpreadsheet.Cells(iRow, 13).Value = objRs("Xh_Tdr")
objSpreadsheet.Cells(iRow, 14).Value = objRs("Xh_Gb")
objSpreadsheet.Cells(iRow, 15).Value = objRs("Xh_Jb")
objSpreadsheet.Cells(iRow, 16).Value = objRs("Xh_Zjy")
objSpreadsheet.Cells(iRow, 17).Value = strFk
objSpreadsheet.Cells(iRow, 18).Value = objRs("Xh_Bz")
objSpreadsheet.Cells(iRow, 19).Value = objRs("Xh_Fkr")
objSpreadsheet.Cells(iRow, 20).Value = objRs("Xh_Zdr")
objSpreadsheet.Cells(iRow, 21).Value = objRs("Xh_Qccbh")
objSpreadsheet.Cells(iRow, 22).Value = objRs("Xh_Dwmc")
objSpreadsheet.Cells(iRow, 23).Value = objRs("Xh_Fksj")
objSpreadsheet.Cells(iRow, 24).Value = objRs("Xh_AddTime")
objSpreadsheet.Cells(iRow, 25).Value = objRs("Xh_AddTimes")
objSpreadsheet.Cells(iRow, 26).Value = objRs("Xh_AddTimess")
objSpreadsheet.Cells(iRow, 27).Value = strState
objSpreadsheet.Cells(iRow, 28).Value = objRs("Xh_Cj")
objSpreadsheet.Cells(iRow, 29).Value = strCz
objSpreadsheet.Cells(iRow, 30).Value = objRs("xh_sfz")
objSpreadsheet.Cells(iRow, 31).Value = objRs("xh_gs")
objSpreadsheet.Cells(iRow, 32).Value = objRs("xh_fksj2")
objSpreadsheet.Cells(iRow, 33).Value = objRs("xh_hs")
objSpreadsheet.Cells(iRow, 34).Value = objRs("nhbh")
For k = 1 To 34
objSpreadsheet.Columns(k).AutoFit
Next
'objSpreadsheet.Cells(iRow, iCol).Font.Size = 10
objSpreadsheet.Cells(iRow, 11).NumberFormat = "#,##0.00"
objSpreadsheet.Cells(iRow, 12).NumberFormat = "#,##0.00"
objSpreadsheet.Cells(iRow, 26).NumberFormat="yyyy-mm-dd hh:mm:ss"
objSpreadsheet.Cells(iRow, 30).NumberFormat="@"
objSpreadsheet.Cells(iRow, 32).NumberFormat="yyyy-mm-dd hh:mm:ss"
iCol = iCol + 1
objRs.MoveNext
        Loop
    End Sub
'保存Excel文件
    Public Function SaveWorkSheet(ByVal strFileName)
        Call objSpreadsheet.Export(strFileName, 0)
        SaveWorkSheet = (Err.Number = 0)
    End Function
End Class

Private Sub DataInitial()
Dim Rs
Set Rs = Server.CreateObject("ADODB.Recordset")
Rs.Open "SELECT * FROM Xh_InData WHERE Xh_Sffk=False ORDER BY AutoId ASC",conn,1,1

Dim objExcel,ExcelPath,strOut
ExcelPath="/Excel/WFk.xls"

Set objExcel = New ExcelExport
objExcel.RowOffset = 1
objExcel.ColumnOffset = 1
objExcel.GenerateWorksheet(Rs)

If objExcel.SaveWorkSheet(Server.MapPath(ExcelPath)) Then
strOut = "已保存为Excel文件.<a href=""" & ExcelPath & """>点击下载</a>"
Else
strOut = "在保存过程中有错误!"
End If

Set objExcel = Nothing
Rs.Close
Set Rs = Nothing
Response.Write strOut
End Sub
Call DataInitial()
Call CloseConn()
%>

#8

引用 7 楼 zhanghuai510 的回复:

Class ExcelExport   

    Private objSpreadsheet   

    Private iColOffset   

    Private iRowOffset  

    Private Sub Class_Initialize()   

        Set objSpreadsheet = Server.CreateObject("OWC11.Spreadsheet")   

        iRowOffset = 2   

        iColOffset = 2   

    End Sub  

    Private Sub Class_Terminate()   

        Set objSpreadsheet = Nothing   

    End Sub  

    Public Property Let ColumnOffset(ByVal iColOff)   

        If iColOff > 0 Then   

            iColOffset = iColOff   

        Else   

            iColOffset = 2   

        End If   

    End Property  

    Public Property Let RowOffset(ByVal iRowOff)   

        If iRowOff > 0 Then   

            iRowOffset = iRowOff   

        Else   

            iRowOffset = 2   

        End If   

    End Property

    Public Sub GenerateWorksheet(ByVal objRs)   

        If objRs.EOF Then Exit Sub   

        Dim objField,iCol,iRow,k

Dim strFk,strState,strCz

        iCol = iColOffset   

        iRow = iRowOffset  

        Dim ArrTitle  

        ArrTitle = Split("姓名|性别|手机|时间|身份证","|")  

        For i = 0 to UBound(ArrTitle)  

            objSpreadsheet.Cells(iRow, iCol).Value = ArrTitle(i)   

            objSpreadsheet.Columns(iCol).AutoFit  

            '设置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).HorizontalAlignment = objSpreadsheet.Constants.xlHAlignCenter '居中   

            iCol = iCol + 1   

        Next

'字段显示结束  

        '显示数据  

        Do While objRs.EOF = False

            iRow = iRow + 1 

            iCol = iColOffset	

objSpreadsheet.Cells(iRow, 1).Value = objRs("xm")

objSpreadsheet.Cells(iRow, 2).Value = objRs("xb")   

objSpreadsheet.Cells(iRow, 3).Value = objRs("sj")  

objSpreadsheet.Cells(iRow, 4).Value = objRs("data")

objSpreadsheet.Cells(iRow, 5).Value = objRs("sfz")  

For k = 1 To 5

objSpreadsheet.Columns(k).AutoFit

Next

objSpreadsheet.Cells(iRow, 4).NumberFormat="yyyy-mm-dd hh:mm:ss"

objSpreadsheet.Cells(iRow, 5).NumberFormat="@"

iCol = iCol + 1

objRs.MoveNext   

        Loop   

    End Sub 

'保存Excel文件

    Public Function SaveWorkSheet(ByVal strFileName)  

        Call objSpreadsheet.Export(strFileName, 0)  

        SaveWorkSheet = (Err.Number = 0)   

    End Function   

End Class  


Private Sub DataInitial()  

Dim Rs   

Set Rs = Server.CreateObject("ADODB.Recordset")   

Rs.Open "select xm,xb,dh,data,sfz from dx",conn,1,1

Dim objExcel,ExcelPath,strOut  

ExcelPath="ssaa.xls"

  

Set objExcel = New ExcelExport   

objExcel.RowOffset = 1   

objExcel.ColumnOffset = 1   

objExcel.GenerateWorksheet(Rs)  

   

If objExcel.SaveWorkSheet(Server.MapPath(ExcelPath)) Then   

strOut = "已保存为Excel文件.<a href=""" & ExcelPath & """>点击下载</a>"   

Else   

strOut = "在保存过程中有错误!"   

End If  

  

Set objExcel = Nothing  

Rs.Close  

Set Rs = Nothing  

Response.Write strOut

End Sub

Call DataInitial()

麻烦看下，为什么我安装了office2003，还是不好使？是哪块改错了么？谢谢

#9

求救.....

#10

求救，谢谢

#1

#2