Recordset

on error goto err: dim i, j as integer dim str1 as string i = 0 j = 0 with commdial1 .cancelerror = true .showsave str1 = .filename end with dim dim dim set set

createexcel as new excel.application wbook as excel.workbook wsheet as excel.worksheet wbook = createexcel.workbooks.add wsheet = wbook.worksheets.add

for i = 0 to recordset1.fields.count - 1 wsheet.cells(1, i + 1).value = recordset1.fields(i).name next i if (recordset1.recordcount > 0) then recordset1.movefirst for i = 0 to recordset1.recordcount - 1 for j = 0 to recordset1.fields.count - 1 wsheet.cells(i + 2, j + 1).value = recordset1(j).value next j recordset1.movenext next i end if wbook.saveas str1 wbook.close true set set set set

createexcel = nothing wbook = nothing wsheet = nothing wbook = createexcel.workbooks.open(str1)

createexcel.visible = true

exit sub err: select case err.number case 32755 msgbox "press cacel button" case 1004 msgbox "overwrite cancel" wbook.close false case else msgbox err.number & " " & err.description end select end sub