从数据库中检索记录并将其以特定格式写入文件

Question

我不太熟悉 asp 经典函数，尽管我现在正在使用一个 .asp 文件，该文件在下拉菜单中的 java 脚本 onChange 事件上显示来自 SQL 数据库的记录。我想要实现的是以下面的格式显示这些记录，并将所有记录写入文本文件，而无需通过 java 脚本调用，即使是从下拉菜单中也是如此。

这是我到目前为止正在处理的问题：

<!--#include virtual="/includes/functions.asp" -->
<%
intBusiness_Catagory = Request("select_catagory")

Set thisConn    = Server.CreateObject("ADODB.Connection")
thisConn.Open CreateAfccDSN()

SelectSQL   = "SELECT * FROM BusinessInfo WHERE ((CatID = " & intBusiness_Catagory & ") or (CatID2 = " & intBusiness_Catagory & ") or (CatID3 = " & intBusiness_Catagory & ")) and (intStatusCodeID = 1) and (intOnWeb = 1) Order By vcBusinessName"
Set SelectRs = thisConn.Execute(SelectSQL)


If SelectRs.EOF Then
    Response.Write("No members found for selected category.<br> Please search <a href='javascript:history.back()'>again</a>.")
Else
%>
<b>Member Search Results:</b>
<p>

<%
End If

    If Not SelectRs.BOF AND Not SelectRs.EOF then
        SelectRs.MoveFirst
        Do Until SelectRs.EOF
%>
            <b><%=SelectRs("vcBusinessName") %></b><br>
            <%=SelectRs("vcPhone") %><br>
            <%=SelectRs("vcPAddress") %><br>
            <%=SelectRs("vcPCity") %>, <%=SelectRs("vcPState") %>&nbsp;&nbsp;<%=SelectRs("vcPZipCode") %><br>
            <%
            If isNull(SelectRs("vcURL")) then

            Else
            %>
                <b>Website: </b><a href="http://<%=SelectRs("vcURL") %>" target="_blank"><%=SelectRs("vcURL") %></a>
            <%
            End If
            %>
            <p>
            <hr>
<%
            SelectRs.MoveNext
        Loop
%>

<%
    End If

SelectRs.Close
Set SelectRs = Nothing
%>

<p style="text-align: right"><small><a href="business_directory_framed.asp">Back to directory index</a></small></p>

任何人都可以协助解决这个问题吗？谢谢。

Answer 1

您只需将 SQL 结果转储到已有的 adodb 记录集中，然后循环记录集并使用 fso com 对象写入 csv 文件。

示例代码（未经测试）

    dim fs, HeadersRow, TempRow, objFolder, DateStr

'#### Buld a NTFS safe filename based on Date
    DateStr = now()
    DateStr = Replace(DateStr, "/", "_")
    DateStr = Replace(DateStr, ":", "_")   

'#### Initalise FileSystemObject
    Set fs = Server.CreateObject("Scripting.FileSystemObject") 

'#### Delete any old Report_ files (optional
    Set objFolder = fs.GetFolder(Server.MapPath("Reports"))

    For Each objFile in objFolder.Files
        FileName = objFile.Name
        if left(FileName,7) = "Report_" then
            if fs.FileExists(Server.MapPath("Reports") & "/" & FileName) then
                on error resume next
                    fs.DeleteFile(Server.MapPath("Reports") & "/" & FileName)
                on error goto 0
            end if
        end if
    Next
    Set objFolder = Nothing

'#### Create a Uniquqe ID for this report
    NewFileName = "Report_" & DateStr & ".csv"

'#### next, get the Query and Populate RS
    SQL = "SELECT * FROM whatever"
    SET RS = db.Execute(SQL)

'#### WE now have a RS, first we need the column headers:
    For fnum = 0 To RS.Fields.Count-1
        HeadersRow = HeadersRow & "," & RS.Fields(fnum).Name & ""
    Next

'#### The loop will have made a string like: ,"col1", "col2", "col3", "col4"
'#### Remove the leading comma ,
    dim LengthInt
    LengthInt = len(HeadersRow)
    HeadersRow = right(HeadersRow, LengthInt - 1)

'#### Dump the headers to the CSV Report
    OutputToCsv HeadersRow, NewFileName
    TempRow = ""

'#### now loop through all the data and dump in CSV report too
    Do Until RS.EOF

        TempRow = ""

        For fnum = 0 To RS.Fields.Count-1
            TempRow = TempRow & "," & RS.Fields(fnum).Value & ""
        Next

        '#### Again, remove the leading comma, then send to CSV
            LengthInt = len(TempRow)
            TempRow = right(TempRow, LengthInt - 1)
            OutputToCsv TempRow, NewFileName

        RS.MoveNext
    Loop

'#### Functions
function OutputToCsv (strToWrite, FileName)
    '#### Simple function to write a line to a given file
    '#### Not the most efficent way of doing it but very re-usable
    dim fs
    Set fs=Server.CreateObject("Scripting.FileSystemObject") 
    If (fs.FileExists(server.MapPath("\") & "\Reports\" & FileName))=true Then
        set fname = fs.OpenTextFile(server.MapPath("\") & "\Reports\" & FileName, 8, True)
    Else
        set fname = fs.CreateTextFile(server.MapPath("\") & "\Reports\" & FileName,true)
    End If        
    fname.WriteLine(strToWrite)
    fname.Close
    set fname=nothing
    set fs=nothing
end function