Export data from VB to excel

Source: Internet
Author: User

If you export data from VB to excel, there may be a lot of such code on the Internet, but you only need to install Excel. Today I share with you that you can export data without installing excel.
Rem Author: Xie Yan Jin Creation Time: 2002-12-20 mail: XieYanJin@163.Com
The REM content is as follows:
Rem reference method: Export (ADO. recordset) or export (RDS. recordset)
Rem supports export of RDS and ADO records
Rem obtains all data types. Some data types are not supported by Excel and have been replaced.

Public Function fieldtype (inttype)
Select case inttype
Case 20
Fieldtype = "int"
Case 1, 128
Fieldtype = "binary"
Case 11
Fieldtype = "bit"
Case 1, 129
Fieldtype = "char"
Case 1, 135
Fieldtype = "datetime"
Case 1, 131
Fieldtype = "varchar"
Case 5
Fieldtype = "float"
Case 1, 205
Fieldtype = "image"
Case 3
Fieldtype = "int"
Case 6
Fieldtype = "money"
Case 1, 130
Fieldtype = "char"
Case 1, 203
Fieldtype = "text"
Case 1, 131
Fieldtype = "numeric"
Case 1, 202
Fieldtype = "varchar"
Case 4
Fieldtype = "real"
Case 1, 135
Fieldtype = "datetime"
Case 2
Fieldtype = "int"
Case 6
Fieldtype = "money"
Case 1, 204
Fieldtype = "varchar"
Case 1, 201
Fieldtype = "text"
Case 1, 128
Fieldtype = "timestamp"
Case 17
Fieldtype = "varchar"
Case 72
Fieldtype = "varchar"
Case 1, 204
Fieldtype = "varbinary"
Case 1, 200
Fieldtype = "varchar"
End select
End Function
Public sub exporttoexcel (adorecordset as ADODB. recordset)
On Error goto excel_err
Dim excel_dsn as string
Dim excel_conn as new ADODB. Connection
Dim excel_adodc as new ADODB. recordset
Dim MYSQL as string
Dim I, j, tmpfield, filename
Obtain the file name through REM.
For I = 0 to 100
If Len (I) = 1 then
Filename = "C:/query_0" & I
Else
Filename = "C:/query _" & I
End if
If Dir (filename & ". xls", vbhidden) = "" then
Exit
End if
Next
Filename = filename & ". xls"
Excel_dsn = "driver = {Microsoft Excel Driver (*. XLS)}; DSN = ''; firstrowhasnames = 1; readonly = false; create_db =" "& filename &" "; DBQ =" & filename
Excel_conn.open excel_dsn
With adorecordset
If not (. EOF and. bof) then
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 ). type )&"("&. fields (I ). definedsize &")"&","
End if
Elseif tmpfield <> "image" then
MySQL = MySQL & trim (. Fields (I). Name) & "& fieldtype (. Fields (I). Type )&","
End if
Next
MySQL = left (TRIM (MySQL), Len (TRIM (MySQL)-1)
MySQL = MySQL &")"
Rem create table name
Excel_adodc.open MySQL, excel_dsn, adopendynamic, adlockpessimistic
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 is not saved
If tmpfield <> "image" then
If isnull (. Fields (j). Value) then
MySQL = MySQL & "null ,"
Else
MySQL = MySQL & "'" &. Fields (j). Value &"',"
End if
End if
Next
MySQL = left (TRIM (MySQL), Len (TRIM (MySQL)-1)
MySQL = MySQL &")"
Excel_adodc.open MySQL, excel_dsn, adopendynamic, adlockpessimistic
. Movenext
Next
Msgbox "system prompt:" & CHR (13) & "you have saved the file to [" & filename & "]", 64, "system information :"
End if
End
Excel_conn.close
Set excel_conn = nothing
Set excel_adodc = nothing
Exit sub
Excel_err:
Msgbox "error:" & err. Description & CHR (13) & "error code:" & err. Number, 64, "system information:" End sub

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.