ASP Classic中的Excel ADO - 将第2行作为标题返回

时间:2013-09-04 21:53:03

标签: excel vba asp-classic ado

如何通过ADODB.Connection ???

将Excel中的第二行(xls& xlsx)用作列标题。
  • Excel来自客户
  • 在上传到ASP页面之前,不能更改Excel
  • 第一行是Excel报告的标题(我想忽略)

当前解决方案(代码在最后):

  1. 客户端上传Excel
  2. 将备份副本创建为“原始”
  3. 打开并阅读前两行Excel
  4. 使用第2行的值
  5. 覆盖第1行
  6. 前两行现在相同
  7. 关闭并重新打开Excel
  8. 选择除了与列名称相同的值之外的所有内容 -e.g。从[Sheet1 $]中选择column1,column2,column3 ...其中ucase(column1)<> 'COLUMN1'
  9. 阅读Excel并打印HTML
  10. 我无法弄清楚的可能的想法:

    • 将“命名范围”分配给第二行
    • 删除第一行(使用ADO和Excel看不到)
    • 使用VBA中的HeaderRowRange.Address将标题行更改为第2行
    • 不是在当前解决方案中创建副本,而是从第2行及以下读取所有内容,然后保存到新的Excel

    当前解决方案代码:

    ' ---------------------------------------------------------------------
    ' 1. Client uploads Excel
    ' ---------------------------------------------------------------------
    xlsfolder = "D:\website\excels\"
    filename = request("filename_from_asp_upload_form")
    xlsfile = xlsfolder & filename
    ' ---------------------------------------------------------------------
    ' 2. Create backup copy as "original"
    ' ---------------------------------------------------------------------
    dim fscopy
    set fscopy=Server.CreateObject("Scripting.FileSystemObject")
    exceltypelower = fscopy.GetExtensionName(xlsfile)
    replace_text = "_BACKUP." & exceltypelower
    xlsfile_copy = replace(xlsfile, ("." & exceltypelower), replace_text)
    fscopy.CopyFile xlsfile,xlsfile_copy
    set fscopy=nothing
    ' ---------------------------------------------------------------------
    ' EXTRA STEP - SELECT EXCEL DRIVER
    ' ---------------------------------------------------------------------
    if  exceltype = "XLS" then
        exceldriver = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & xlsfile & ";Extended Properties=""Excel 8.0;"""
    elseif exceltype = "XLSX" then
        exceldriver = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & xlsfile & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""
        exceldriver2 = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & xlsfile & ";Extended Properties=""Excel 8.0;HDR=No;"""
        '*** Second driver allows first row to be read as data and not header allowing Excel cells to be overwritten
    else
        '**** default to 97-2003 format. ELSE just in case
        exceldriver = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & xlsfile & ";Extended Properties=""Excel 8.0;"""
    end if
    ' ---------------------------------------------------------------------
    ' 3. Open and Read first 2 rows of Excel
    ' 4. Overwrite row 1 with values from row 2
    ' ---------------------------------------------------------------------
    ' NOTE: There is another step at UPLOAD that the user flags what kind of Excel Report it is. 
    '   Since there are just a few now, I have the skip_title variable hard-coded
    '   IF SKIP_TITLE = "Y"... that means the column headers are on row 2
    '   IF SKIP_TITLE = "N"... that means the column headers are on row 1 and this is unnecessary 
    ' ---------------------------------------------------------------------
    if skip_title = "Y" then
        excel_query2 = "Select * from [Sheet1$] "
        Const adOpenStatic = 3
        Const adLockOptimistic = 3
        Const adUseClient = 3
        Set objConn = CreateObject("ADODB.Connection")
        Set objRecordset = CreateObject("ADODB.Recordset")
        objConn.Open (exceldriver2)
        objRecordset.CursorLocation = adUseClient
        objRecordset.Open excel_query2 , objConn, adOpenStatic, adLockOptimistic
    
        counter = 1
        headcount = 0 
        colcount = objRecordSet.Fields.Count    ' How many columns there are to traverse
        p = objRecordSet.GetRows(colcount,0)    ' Write excel_query2 results for number of columns above
    
        objRecordSet.MoveFirst
        do until objRecordSet.EOF  or counter = 0 
            for each x in objRecordSet.Fields
                objRecordSet.Fields(headcount).Value = p(headcount, 1)  'overwrite row 1 with row 2
                headcount = headcount + 1
                next
            counter = counter - 1
            objRecordSet.MoveNext
        loop
        objRecordSet.Update
        objRecordset.Close
        objConn.Close
    end if 
    ' ---------------------------------------------------------------------
    ' 5. The first 2 rows are now identical
    ' 6. Close and Re-Open Excel
    ' ---------------------------------------------------------------------
    set objConnection = Server.CreateObject("ADODB.Connection") 
    objConnection.Open (exceldriver)
    ' ---------------------------------------------------------------------
    ' 7. Select everything except values that equal name of column names
    ' -e.g. Select column1, column2, column3... from [Sheet1$] where ucase(column1) <> 'COLUMN1'
    ' ---------------------------------------------------------------------
    excel_query = "Select column1, column2, column3... from [Sheet1$] where ucase(column1) <> 'COLUMN1' " 'example
    set objRS = objConnection.execute(excel_query)
    ' ---------------------------------------------------------------------
    ' 8. Read Excel and Print HTML
    ' ---------------------------------------------------------------------
    response.write "<table><thead><tr>"
    for each x in objRS.Fields
        response.write("<th>" & ucase(x.name) & "</th>") 
    next
    response.write "</tr></thead>"
    
    response.write "<tbody>"
    do until objRS.EOF
        response.write "<tr>"   
        for each fld in objRS.Fields
            response.write "<td>" & fld.value & "</td>" 
        next
        response.write "</tr>"  
        objRS.MoveNext
    loop
    objRS.close
    objConnection.Close
    response.write "</tbody></table>"
    ' ---------------------------------------------------------------------
    ' Le Fin or Da End
    

1 个答案:

答案 0 :(得分:1)

Sub Test22()

Dim cn As New ADODB.Connection
Dim rsT As New ADODB.Recordset
Dim numCols As Long, numRows As Long, x As Long

    With cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Data Source=" & ThisWorkbook.Path & _
                            "\ADOXSource.xls;Extended Properties=Excel 8.0;"
        .CursorLocation = adUseClient
        .Open
    End With

    'read the whole sheet
    rsT.Open "select * from [Sheet1$]", cn
    rsT.MoveLast

    'get # of rows/cols
    numCols = rsT.Fields.Count
    numRows = rsT.RecordCount

    rsT.Close

    'get data from specific range
    rsT.Open "select * from [Sheet1$A2:" & Chr(64 + numCols) & (numRows - 1) & "]", cn

    'I'm testing this in excel...
    For x = 0 To rsT.Fields.Count - 1
        Sheet1.Range("a1").Offset(0, x).Value = rsT.Fields(x).Name
    Next x
    Sheet1.Range("a2").CopyFromRecordset rsT

End Sub