データベースからレコードを取得し、特定の形式でファイルに書き込む

Question

私は現在、asp-classic関数に精通していませんが、SQLスクリプトを使用してSQLデータベースのレコードを表示する.aspファイルを使用していますonChangeイベントをドロップダウンメニューに表示します。私が達成しようとしているのは、これらのレコードを以下の形式で表示し、それらのすべてをドロップダウンメニューからでもjava-scriptを通して呼び出さずにテキストファイルに書き出すことです。ここで

は、私がこれまでに働いているものです：

<!--#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