Vb6导出数据到Excel或word文件中

2024-04-11 00:01•HTML/CSS•阅读 381

VB6.0报表导出的实现一例，将内容导出到Excel中，或者导出到Word文件中，在平时挺实用，不过代码只测试了下，可以用，核心代码如下:

VERSION 5.00

Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"

Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDATGRD.OCX"

Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"

Begin VB.Form Form1

Caption = "报表导出"

ClientHeight = 5910

ClientLeft = 60

ClientTop = 345

ClientWidth = 7410

LinkTopic = "Form1"

ScaleHeight = 5910

ScaleWidth = 7410

StartUpPosition = 3 \'窗口缺省

Begin MSAdodcLib.Adodc Adodc1

Height = 570

Left = 825

Top = 6075

Width = 2025

_ExtentX = 3572

_ExtentY = 1005

ConnectMode = 0

CursorLocation = 3

IsolationLevel = -1

ConnectionTimeout= 15

CommandTimeout = 30

CursorType = 3

LockType = 3

CommandType = 8

CursorOptions = 0

CacheSize = 50

MaxRecords = 0

BOFAction = 0

EOFAction = 0

ConnectStringType= 1

Appearance = 1

BackColor = -2147483643

ForeColor = -2147483640

Orientation = 0

Enabled = -1

Connect = ""

OLEDBString = ""

OLEDBFile = ""

DataSourceName = ""

OtherAttributes = ""

UserName = ""

Password = ""

RecordSource = ""

Caption = "Adodc1"

BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}

Name = "宋体"

Size = 9

Charset = 134

Weight = 400

Underline = 0 \'False

Italic = 0 \'False

Strikethrough = 0 \'False

EndProperty

_Version = 393216

End

Begin VB.Frame Frame1

Appearance = 0 \'Flat

BackColor = &H80000000&

ForeColor = &H80000008&

Height = 1095

Left = 15

TabIndex = 1

Top = 825

Width = 7335

Begin VB.ComboBox cboFields

BackColor = &H00FFFFC0&

Height = 300

Left = 975

Style = 2 \'Dropdown List

TabIndex = 4

Top = 240

Width = 3555

End

Begin VB.TextBox txtdata

BackColor = &H00FFFFC0&

Height = 300

Left = 945

TabIndex = 3

Top = 690

Width = 6165

End

Begin VB.ComboBox cboOperator

BackColor = &H00FFFFC0&

Height = 300

Left = 5325

Style = 2 \'Dropdown List

TabIndex = 2

Top = 255

Width = 1725

End

Begin VB.Label Label3

Caption = "关键字"

ForeColor = &H00FF0000&

Height = 255

Left = 4650

TabIndex = 7

Top = 285

Width = 570

End

Begin VB.Label Label1

Caption = "字段名称"

ForeColor = &H00FF0000&

Height = 285

Left = 150

TabIndex = 6

Top = 315

Width = 915

End

Begin VB.Label Label2

Caption = "关键字"

ForeColor = &H00FF0000&

Height = 255

Left = 135

TabIndex = 5

Top = 750

Width = 1155

End

Begin MSComctlLib.Toolbar Toolbar1

Align = 1 \'Align Top

Height = 855

Left = 0

TabIndex = 0

Top = 0

Width = 7410

_ExtentX = 13070

_ExtentY = 1508

ButtonWidth = 1931

ButtonHeight = 1349

Appearance = 1

ImageList = "ImageList1"

_Version = 393216

BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}

NumButtons = 6

BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}

Caption = "查询"

ImageIndex = 1

EndProperty

BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}

Caption = "导出到Word"

ImageIndex = 2

EndProperty

BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}

Caption = "导出到Excel"

ImageIndex = 3

EndProperty

BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}

Caption = "导出到HTML"

ImageIndex = 4

EndProperty

BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}

Caption = "打印"

ImageIndex = 5

EndProperty

BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}

Caption = "退出"

ImageIndex = 6

EndProperty

Begin MSComctlLib.ImageList ImageList1

Left = 6810

Top = 150

_ExtentX = 1005

_ExtentY = 1005

BackColor = -2147483643

ImageWidth = 32

ImageHeight = 32

MaskColor = 12632256

_Version = 393216

BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}

NumListImages = 6

BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}

Picture = "Form1.frx":0000

Key = ""

EndProperty

BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}

Picture = "Form1.frx":0CDA

Key = ""

EndProperty

BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}

Picture = "Form1.frx":19B4

Key = ""

EndProperty

BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}

Picture = "Form1.frx":268E

Key = ""

EndProperty

BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}

Picture = "Form1.frx":3368

Key = ""

EndProperty

BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}

Picture = "Form1.frx":4042

Key = ""

EndProperty

End

Begin MSDataGridLib.DataGrid DataGrid1

Bindings = "Form1.frx":4D1C

Height = 3885

Left = 15

TabIndex = 8

Top = 1995

Width = 7365

_ExtentX = 12991

_ExtentY = 6853

_Version = 393216

AllowUpdate = 0 \'False

HeadLines = 1

RowHeight = 15

FormatLocked = -1 \'True

BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}

Name = "宋体"

Size = 9

Charset = 134

Weight = 400

Underline = 0 \'False

Italic = 0 \'False

Strikethrough = 0 \'False

EndProperty

BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}

Name = "宋体"

Size = 9

Charset = 134

Weight = 400

Underline = 0 \'False

Italic = 0 \'False

Strikethrough = 0 \'False

EndProperty

ColumnCount = 12

BeginProperty Column00

DataField = "商品编号"

Caption = "商品编号"

BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}

Type = 0

Format = ""

HaveTrueFalseNull= 0

FirstDayOfWeek = 0

FirstWeekOfYear = 0

LCID = 2052

SubFormatType = 0

EndProperty

BeginProperty Column01

DataField = "商品名称"

Caption = "商品名称"

BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}

Type = 0

Format = ""

HaveTrueFalseNull= 0

FirstDayOfWeek = 0

FirstWeekOfYear = 0

LCID = 2052

SubFormatType = 0

EndProperty

BeginProperty Column02

DataField = "拼音码"

Caption = "拼音码"

BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}

Type = 0

Format = ""

HaveTrueFalseNull= 0

FirstDayOfWeek = 0

FirstWeekOfYear = 0

LCID = 2052

SubFormatType = 0

EndProperty

BeginProperty Column03

DataField = "批号"

Caption = "批号"

BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}

Type = 0

Format = ""

HaveTrueFalseNull= 0

FirstDayOfWeek = 0

FirstWeekOfYear = 0

LCID = 2052

SubFormatType = 0

EndProperty

BeginProperty Column04

DataField = "产地"

Caption = "产地"

BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}

Type = 0

Format = ""

HaveTrueFalseNull= 0

FirstDayOfWeek = 0

FirstWeekOfYear = 0

LCID = 2052

SubFormatType = 0

EndProperty

BeginProperty Column05

DataField = "规格"

Caption = "规格"

BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}

Type = 0

Format = ""

HaveTrueFalseNull= 0

FirstDayOfWeek = 0

FirstWeekOfYear = 0

LCID = 2052

SubFormatType = 0

EndProperty

BeginProperty Column06

DataField = "包装"

Caption = "包装"

BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}

Type = 0

Format = ""

HaveTrueFalseNull= 0

FirstDayOfWeek = 0

FirstWeekOfYear = 0

LCID = 2052

SubFormatType = 0

EndProperty

BeginProperty Column07

DataField = "单位"

Caption = "单位"

BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}

Type = 0

Format = ""

HaveTrueFalseNull= 0

FirstDayOfWeek = 0

FirstWeekOfYear = 0

LCID = 2052

SubFormatType = 0

EndProperty

BeginProperty Column08

DataField = "进价"

Caption = "进价"

BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}

Type = 0

Format = ""

HaveTrueFalseNull= 0

FirstDayOfWeek = 0

FirstWeekOfYear = 0

LCID = 2052

SubFormatType = 0

EndProperty

BeginProperty Column09

DataField = "库存"

Caption = "库存"

BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}

Type = 0

Format = ""

HaveTrueFalseNull= 0

FirstDayOfWeek = 0

FirstWeekOfYear = 0

LCID = 2052

SubFormatType = 0

EndProperty

BeginProperty Column10

DataField = "盘点数量"

Caption = "盘点数量"

BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}

Type = 0

Format = ""

HaveTrueFalseNull= 0

FirstDayOfWeek = 0

FirstWeekOfYear = 0

LCID = 2052

SubFormatType = 0

EndProperty

BeginProperty Column11

DataField = "盘点盈亏数量"

Caption = "盘点盈亏数量"

BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}

Type = 0

Format = ""

HaveTrueFalseNull= 0

FirstDayOfWeek = 0

FirstWeekOfYear = 0

LCID = 2052

SubFormatType = 0

EndProperty

SplitCount = 1

BeginProperty Split0

MarqueeStyle = 4

SizeMode = 1

BeginProperty Column00

ColumnWidth = 750.047

EndProperty

BeginProperty Column01

ColumnWidth = 1500.095

EndProperty

BeginProperty Column02

ColumnWidth = 659.906

EndProperty

BeginProperty Column03

ColumnWidth = 599.811

EndProperty

BeginProperty Column04

ColumnWidth = 599.811

EndProperty

BeginProperty Column05

ColumnWidth = 659.906

EndProperty

BeginProperty Column06

ColumnWidth = 494.929

EndProperty

BeginProperty Column07

ColumnWidth = 480.189

EndProperty

BeginProperty Column08

ColumnWidth = 585.071

EndProperty

BeginProperty Column09

ColumnWidth = 569.764

EndProperty

BeginProperty Column10

ColumnWidth = 884.976

EndProperty

BeginProperty Column11

ColumnWidth = 1154.835

EndProperty

End

Attribute VB_Name = "Form1"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = False

Attribute VB_PredeclaredId = True

\' http://www.codesc.net

Attribute VB_Exposed = False

Option Explicit

Public tb As String, sql As String

Private Sub Form_Load()

Dim fld

Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "\db_medicine.mdb;Persist Security Info=False"

Adodc1.RecordSource = "select * from tb_kc"

Adodc1.Refresh

sql = "tb_kc"

Set fld = Adodc1.Recordset.Fields

For Each fld In Adodc1.Recordset.Fields

\'向combo控件中添加字段

cboFields.AddItem fld.Name

cboFields.ListIndex = 0

\'向cboOperator中添加查询条件

cboOperator.AddItem ("like")

cboOperator.AddItem (">")

cboOperator.AddItem ("=")

cboOperator.AddItem (">=")

cboOperator.AddItem ("<")

cboOperator.AddItem ("<=")

cboOperator.AddItem ("<>")

cboOperator.ListIndex = 0

\'Download by <a href="http://www.srcfans.comEnd">http://www.srcfans.com End</a> Sub

Private Sub ExptoExcel()

Dim i As Integer, r As Integer, c As Integer

Dim newxls As New Excel.Application

Dim newbook As New Excel.Workbook

Dim newsheet As New Excel.Worksheet

Set newbook = newxls.Workbooks.Add \'创建工作簿

Set newsheet = newbook.Worksheets(1) \'创建工作表

If sql <> "" Then

Adodc1.RecordSource = sql

Adodc1.Refresh

End If

If Adodc1.Recordset.RecordCount > 0 Then

For i = 0 To DataGrid1.Columns.Count - 1

newsheet.Cells(1, i + 1) = DataGrid1.Columns(i).Caption

Next i

\'指定表格内容

Adodc1.Recordset.MoveFirst

Do Until Adodc1.Recordset.EOF

r = Adodc1.Recordset.AbsolutePosition

For c = 0 To DataGrid1.Columns.Count - 1

DataGrid1.Col = c

newsheet.Cells(r + 1, c + 1) = DataGrid1.Columns(c)

Next c

Adodc1.Recordset.MoveNext

Loop

Dim myval As Long

Dim mystr As String

myval = MsgBox("是否保存该Excel表?", vbYesNo, "提示窗口")

If myval = vbYes Then

mystr = InputBox("请输入文件名称", "输入窗口")

If Len(mystr) = 0 Then

MsgBox "系统不允许文件名称为空！", , "提示窗口"

Exit Sub

End If

On Error GoTo ErrSave

newsheet.SaveAs App.Path & "\Excel文件\" & mystr & ".xls"

MsgBox "Excel文件保存成功，位置：" & App.Path & "\Excel文件\" & mystr & ".xls", , "提示窗口"

newxls.Quit

ErrSave:

Exit Sub

MsgBox Err.Description, , "提示窗口"

End If

End Sub

Private Sub ExptoWord()

Dim i As Integer, j As Integer

Dim ifieldcount As Integer, irecordcount As Integer

Dim wdapp As Word.Application

Dim wddoc As Word.Document

Dim atable As Word.Table

\' cmdFind_Click

If Adodc1.Recordset.RecordCount > 0 Then

irecordcount = Adodc1.Recordset.RecordCount

\'创建word应用程序，这一句话打开word2000

Set wdapp = CreateObject("Word.Application")

\'在word中添加一个新文档

Set wddoc = wdapp.Documents.Add

With wdapp

.Visible = True

.Activate

\'在word中增加一个表格

.Caption = "商品信息表"

Set atable = .ActiveDocument.Tables.Add(.Selection.Range, irecordcount + 1, 12)

atable.Cell(1, 1).Range.InsertAfter "商品编号"

atable.Cell(1, 2).Range.InsertAfter "商品名称"

atable.Cell(1, 3).Range.InsertAfter "拼音码"

atable.Cell(1, 4).Range.InsertAfter "批号"

atable.Cell(1, 5).Range.InsertAfter "产地"

atable.Cell(1, 6).Range.InsertAfter "规格"

atable.Cell(1, 7).Range.InsertAfter "包装"

atable.Cell(1, 8).Range.InsertAfter "单位"

atable.Cell(1, 9).Range.InsertAfter "进价"

atable.Cell(1, 10).Range.InsertAfter "库存"

atable.Cell(1, 11).Range.InsertAfter "盘点数量"

atable.Cell(1, 12).Range.InsertAfter "盘点盈亏数量"

\'指定表格内容

Adodc1.Recordset.MoveFirst

Do Until Adodc1.Recordset.EOF

atable.Cell(DataGrid1.Bookmark + 1, 1).Range.InsertAfter Adodc1.Recordset.Fields("商品编号")

atable.Cell(DataGrid1.Bookmark + 1, 2).Range.InsertAfter Adodc1.Recordset.Fields("商品名称")

atable.Cell(DataGrid1.Bookmark + 1, 3).Range.InsertAfter Adodc1.Recordset.Fields("拼音码")

If Adodc1.Recordset.Fields("批号") <> "" Then atable.Cell(DataGrid1.Bookmark + 1, 4).Range.InsertAfter Adodc1.Recordset.Fields("批号")

If Adodc1.Recordset.Fields("产地") <> "" Then atable.Cell(DataGrid1.Bookmark + 1, 5).Range.InsertAfter Adodc1.Recordset.Fields("产地")

If Adodc1.Recordset.Fields("规格") <> "" Then atable.Cell(DataGrid1.Bookmark + 1, 6).Range.InsertAfter Adodc1.Recordset.Fields("规格")

If Adodc1.Recordset.Fields("包装") <> "" Then atable.Cell(DataGrid1.Bookmark + 1, 7).Range.InsertAfter Adodc1.Recordset.Fields("包装")

If Adodc1.Recordset.Fields("单位") <> "" Then atable.Cell(DataGrid1.Bookmark + 1, 8).Range.InsertAfter Adodc1.Recordset.Fields("单位")

If Adodc1.Recordset.Fields("进价") <> "" Then atable.Cell(DataGrid1.Bookmark + 1, 9).Range.InsertAfter Adodc1.Recordset.Fields("进价")

If Adodc1.Recordset.Fields("库存") <> "" Then atable.Cell(DataGrid1.Bookmark + 1, 10).Range.InsertAfter Adodc1.Recordset.Fields("库存")

If Adodc1.Recordset.Fields("盘点数量") <> "" Then atable.Cell(DataGrid1.Bookmark + 1, 11).Range.InsertAfter Adodc1.Recordset.Fields("盘点数量")

If Adodc1.Recordset.Fields("盘点盈亏数量") <> "" Then atable.Cell(DataGrid1.Bookmark + 1, 12).Range.InsertAfter Adodc1.Recordset.Fields("盘点盈亏数量")

Adodc1.Recordset.MoveNext

Loop

End With

\'清除word对象

Set wdapp = Nothing

Set wddoc = Nothing

Else

MsgBox "没有商品！", , "提示窗口"

End If

End Sub

Private Sub cFind() \'查询

tb = "tb_kc"

Select Case Adodc1.Recordset.Fields(cboFields.ListIndex).Type

Case 202 \'字符数据

If cboOperator.Text = "like" Then

sql = tb & " where " & tb & "." & cboFields & " like+ \'" + txtdata + "\'+\'%\'"

Else

sql = tb & " where " & tb & "." & cboFields & cboOperator & "\'" + txtdata + "\'"

End If

Case 5 \'货币数据

If IsNumeric(txtdata) = False Then

MsgBox "请输入正确的数据！", , "提示窗口"

Exit Sub

End If

If cboOperator.Text = "like" Then

MsgBox "货币数据不能选用“Like”作为运算符！", , "提示窗口"

cboOperator.ListIndex = 1

End If

sql = tb & " where " & tb & "." & cboFields & cboOperator & txtdata

Case 3 \'数字数据

If IsNumeric(txtdata) = False Then

MsgBox "请输入正确的数据！", , "提示窗口"

Exit Sub

End If

If cboOperator.Text = "like" Then

MsgBox "数字数据不能选用“Like”作为运算符！", , "提示窗口"

cboOperator.ListIndex = 1

End If

sql = tb & " where " & tb & "." & cboFields & cboOperator & txtdata

End Select

If sql <> "" Then

Adodc1.RecordSource = sql

Adodc1.Refresh

End If

End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)

Select Case Button.Caption

Case "查询"

cFind

Case "导出到Word"

ExptoWord

Case "导出到Excel"

ExptoExcel

Case "导出到HTML"

If DataEnvironment1.Connection1.State = adStateOpen Then

DataEnvironment1.Connection1.Close

End If

DataEnvironment1.Connection1.Open

DataEnvironment1.Commands(1).ActiveConnection = DataEnvironment1.Connection1

DataEnvironment1.Commands(1).CommandText = sql

DataReport1.Refresh

DataReport1.ExportReport rptKeyHTML, "" & App.Path & "\Myfile.htm ", True, , rptRangeAllPages

MsgBox "文件已导出到工程目录下！", vbInformation, "信息提示"

Case "打印"

If DataEnvironment1.Connection1.State = adStateOpen Then

DataEnvironment1.Connection1.Close

End If

DataEnvironment1.Connection1.Open

DataEnvironment1.Commands(1).ActiveConnection = DataEnvironment1.Connection1

DataEnvironment1.Commands(1).CommandText = sql

DataReport1.Show

DataReport1.Refresh

DataReport1.Show

Case "退出"

End

End Select

End Sub

这里可以代码高亮，看的更清：Vb导出数据到Excel或word文件中

上一篇 »VB.net 将dataGridView中的数据导出到excel
下一篇 »asp.net中将DataGrid数据导出到excel或word文件中

Vb6导出数据到Excel或word文件中

相关推荐

将ASP.NET页面内的数据导出到Excel 或 Word中

轉:VB6中将数据导出到Excel提速之法

ASP.NET，C#将数据导出到Word或Excel

matlab 生成图像，直接导出到excel， word，转载

将从SQL数据库中查询出来的数据导出为Excel文档ASP.NET，VB？

VB6.0 excel 导入和导出

c#中数据从数据库到客户端主要几种的导出方式？导出到excel，导出到word

转帖：[Asp.net技术]asp.net中Word\Excel的导出数据制作，懒人发掘