Set SURVEY_APP_CONNECTION = Server.CreateObject("ADODB.Connection") SURVEY_APP_CONNECTION= "DBQ=C:\Development\Websites\surveys.sawebdesign\db\SelectSurveyASPAdvanced.mdb;Driver={Microsoft Access Driver (*.mdb)};" Set rsExport = Server.CreateObject("ADODB.Recordset") dim strSQL Set xl = CreateObject("Excel.Application") 'Set xlBk = xl.Workbooks.Add("C:\\template.xlsx") xl.Visible=True Set xlBk = xl.Workbooks.Add stop strSQL = "SELECT sur_response.response_id As ResponseID ,sur_item.item_alias As ItemAlias," & _ "sur_item.item_text As ItemText, sur_response_answer.other_text, sur_item.other_text As ItemOtherText," & _ "other_yn, sur_response_answer.answer_text As ResponseAnswerText, " & _ "sur_item_answer.answer_text As ItemAnswerText, subitem_text " & _ "FROM (((((sur_survey INNER JOIN sur_survey_to_item_mapping ON " & _ "sur_survey.survey_id = sur_survey_to_item_mapping.survey_id)" & _ " INNER JOIN sur_item ON sur_survey_to_item_mapping.item_id = sur_item.item_id)" & _ " INNER JOIN ((sur_response INNER JOIN sur_response_answer ON " & _ "sur_response.response_id = sur_response_answer.response_id)" & _ " LEFT JOIN sur_user ON sur_response.username = sur_user.username)" & _ " ON sur_item.item_id = sur_response_answer.item_id)" & _ " LEFT JOIN sur_item_answer ON sur_response_answer.answer_id = sur_item_answer.answer_id)" & _ " LEFT JOIN sur_subitem ON sur_response_answer.subitem_id = sur_subitem.subitem_id) " & _ " left JOIN sur_email_address ON sur_response.email_address_id = sur_email_address.email_address_id " & _ "WHERE sur_survey.survey_id = 154" rsExport.activeconnection=SURVEY_APP_CONNECTION rsExport.CursorType=2 rsExport.Locktype=3 rsExport.Open strSQL If Not rsExport.EOF or rsExport.BOf Then With xlbk.Worksheets(1) For i = 4 To rsExport.Fields.Count - 1 .Cells(1, i +1) = rsExport.Fields(i).Name Next .Cells(i-2, 1).CopyFromRecordset rsExport End With dim filename filename="C:\dump\template2.xlsx" xl.Visible=True ' xl.SaveWorkspace(filename) xlBk.ActiveWorkbook.SaveAs filename rsExport.close xl.Quit set xl= Nothing set xlbk=nothing set rsExport=nothing stop else MsgBox "No Records" end if
xl.ActiveWorkbook.Close savechanges=true
var
This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)