Quote: export (ado.recordset) or export (rds.recordset)
/// s t a r t //
Function FieldType (intType) Select Case intType Case 20 FieldType = "int" Case 128 FieldType = "binary" Case 11 FieldType = "bit" Case 129 FieldType = "char" Case 135 FieldType = "datetime" Case 131 FieldType = "varchar" Case 5 FieldType = "float" case 205 fieldtype = "image" case 3 FieldType = "int" case 6 fieldtype = "Money" case 130 fieldtype = "char" case 203 fieldType = "text" case 131 fieldtype = "numeric" CASE 202 FieldType = "varchar" case 4 FieldType = "real" case 135 fieldtype = "datetime" case 2 FieldType = "INT" case 6 FieldType = "Money" case 204 fieldtype = "varcha" case 201 FIELDTYPE = "text" case 128 FieldType = "TimeStamp" case 17 FieldType = "varchar" case 72 fieldtype = "varchar" case 204 fieldtype = "varbinary" case 200 FieldType = "varchar" End SelectEnd Function
Sub Export (AdoRecordSet) Rem AdoRecordSet pass an object, or may be Rds.Recordset Adodb.RecordSetRem exported to the user's desktop Query_ digital combined .xlsOn Error Resume Next Dim Excel_Dsn Dim Excel_Conn Dim Excel_Adodc Dim mySql, fs Dim i, j , TmpField, FileName, WshShell Rem Desktop path Set WshShell = CreateObject ( "Wscript.Shell") Rem create a connection Set Excel_Conn = CreateObject ( "ADODB.Connection") Rem create a record Set Excel_Adodc = CreateObject ( "ADODB.RecordSet") REM Create file object set fs = createObject ("scripting.filesystemObject") REM determines if the file exists, automatically renamed (0 - 99), can modify for i = 0 to 99 if Len (i) = 1 Then filename = wshshell.SpecialFolders ("Desktop") & "/ query_0" & I else filename = wshshell.specialfolders ("Desktop") & "query_" & i end if if not fs.fileexists (filename & ".xls") THEN EXIT for endiff Next filename = filename & ".xls" Rem creates an Excel driver, general WINDOW 98 or more computers have this driver Excel_DSN = "driver = {Microsoft Excel Driver (* .xls)}; DSN = '; firs TROWHASNAMES = 1; READONLY = FALSE; CREATE_DB = "" "& FileName &" ""; DBQ = "& FileName Excel_Conn.Open Excel_Dsn With AdoRecordSet If Not (.EOF And .BOF) Then .MoveFirst mySql =" Create Table [Query ] ("For i = 0 to .fields.count - 1 Tmpfield = FieldType (.fields (i) .type) if tmpfield =" char "or tmpfield =" varchar "or tmpfield =" nchar "or tmpfield =" nvarchar " OR TMPFIELD = "Varbinary"
Then if .fields (i) .definedsize> = 256 Then mysql = mysql & trim (.fields (i) .Name) & "Text," Else MySQL = mysql & trim (.fields (i) .name) & "" & FieldType & "(" & .fields (i) .definedsize & ")" & "," END IF Rem Image does not export elseif tmpfield <> "image" "" "" Mysql & Trim (.fields (i) .Name) & "& FieldType", "end if next mysql = left (trim (mysql), len (Trim (mysql)) 1) mysql = mysql & ") Rem Create a table name Rem This cannot be used using excel_adodc.close, because the object will be automatically turned off, the object will cause the server Excel_adodc.open mysql, Excel_DSN REM capture error message IF Err.Number <> 0 THEN MSGBOX "error:" & Err.Description, 64, "System Information:" EXIT SUB END IF REM Insert Data for i = 0 to .recordcount - 1 mysql = "Insert Into [query] VALUES ("for j = 0 to .fields.count - 1 tmpfield = fieldType (.fields (j) .Type) Rem Image data type does not export if TmpField <>" Image "" "" "" "" "" "" " Value) Then mysql = mysql & "null," else mysql = mysql & "'" & trim (.fields (j) .value) & "" end if end if next mysql =
Left (Trim (mysql), len (Trim (mysql)) - 1) mysql = mysql & ")" Rem This cannot use Excel_adodc.close, because the object will be turned off because the object will be turned off, and the server will not cause burden to the server. Excel_adodc.open mysql, Excel_DSN Rem Capture Error Information If Err.Number <> 0 THEN MSGBOX "error:" & Err.Description, 64, "System Information:" EXIT SUB End if .MOvenext Next Msgbox "System Tips:" & CHR (13) & "has saved files to" "" & filename & "" "], 64," system information: "END IF REM Close and release the object Excel_conn.close set excel_conn = Nothing set excel_adodc = Nothing end wirthnd Sub // end IF //
