<% Class ExportController_Class Private m_useLayout Private m_title Private Sub Class_Initialize() m_useLayout = False ' streams a file, not a page m_title = "Export" End Sub Public Property Get useLayout useLayout = m_useLayout End Property Public Property Let useLayout(v) m_useLayout = v End Property Public Property Get Title Title = m_title End Property Public Property Let Title(v) m_title = v End Property '------------------------------------------------------------------------------------------------------------------- ' GET /export/businesses : CSV of everything matching the list's search/filters (opens directly in Excel) '------------------------------------------------------------------------------------------------------------------- Public Sub businesses() Dim f, k, rs, line, n, fileName Set f = CreateObject("Scripting.Dictionary") For Each k In Array("q", "industry", "status", "show", "contacted", "phone", "sort", "dir") f(k) = Trim(CStr(Request.QueryString(k))) Next f("q") = Left(f("q"), 100) Server.ScriptTimeout = 600 fileName = "businesses-" & Year(Date) & Right("0" & Month(Date), 2) & Right("0" & Day(Date), 2) & ".csv" Response.Clear Response.Buffer = True Response.CodePage = 65001 Response.Charset = "utf-8" Response.ContentType = "text/csv" Response.AddHeader "Content-Disposition", "attachment; filename=""" & fileName & """" Response.Write ChrW(&HFEFF) ' UTF-8 BOM so Excel reads accents correctly Response.Write "Business,Contact,Industry,Phone,Email,Website,Address,City,State,Zip,Status,Customer,Last contacted,Next action" & vbCrLf Set rs = BusinessRepository().ExportRows(f) n = 0 Do While Not rs.EOF line = Csv_Cell(rs("name")) & "," & Csv_Cell(rs("contact_name")) & "," & Csv_Cell(rs("industry_name")) & "," & _ Csv_Cell(rs("phone")) & "," & Csv_Cell(rs("email")) & "," & Csv_Cell(rs("website")) & "," & _ Csv_Cell(rs("address1")) & "," & Csv_Cell(rs("city")) & "," & Csv_Cell(rs("state")) & "," & _ Csv_Cell(rs("zip")) & "," & Csv_Cell(Businesses_StatusLabel(rs("status"))) & "," & _ Csv_Cell(CustomerText(rs("is_customer"))) & "," & Csv_Cell(Date_Fmt(rs("last_contacted_at"))) & "," & _ Csv_Cell(Date_Fmt(rs("next_action_date"))) Response.Write line & vbCrLf n = n + 1 If n Mod 2000 = 0 Then Response.Flush rs.MoveNext Loop rs.Close Response.End End Sub Private Function CustomerText(v) If v & "" = "1" Then CustomerText = "Yes" Else CustomerText = "" End Function End Class Dim ExportController_Class__Singleton Function ExportController() If IsEmpty(ExportController_Class__Singleton) Then Set ExportController_Class__Singleton = New ExportController_Class End If Set ExportController = ExportController_Class__Singleton End Function %>