VB 程序设计

10个成员

导出EXCEL/FOXPRO/PRODOX格式表

发表于 2016-12-24 3576 次查看
  一般是在ACCESS或是SQLSERVER中查寻,或是汇总,然后生成一个‘记录集’可以显示在GRID里,也可以将这个记录集导出到磁盘中。  

  下面可以导出Xls,DBF,DB,MDB(表),这些功能是由ISAM数据库接口实现,为了导出各种版本的文件,我在MS网站下载了最新的JET4和MDAC6。前者到用于桌面数据库如ACCESS,FOXPRO的组件,后者是实现新版本ADO组件。分别在:

  http://download.microsoft.com/download/access2000/SP/4.0/NT5/EN-US/Jet40SP5_W2K.exe
   http://download.microsoft.com/download/dasdk/install/2.60.6526.3/WIN98Me/CN/mdac_typ.exe

  这些是标准的SQL导出语句:

  select * into [office/9.shtml' target='_blank' class='article'>Excel 8.0;database=导出目录].导出表名 from 表

  select * into [FoxPro 2.6;database=导出目录].导出表名 from 表

  select * into [FoxPro 2.5;database=同上].导出表名 from 表

  select * into [dBase III;database=同上].导出表名 from 表

  select * into [Paradox 4.X;database=同上].导出表名 from 表

  select * into [;database=C:\temp\xxx.mdb].导出表名 from 表

  下面程序为实现用户自定议文件名用变量代替一部分。

  http://old.bccn.net/Article/UploadFDL0024/200512/20051214214322535.jpg

  http://go.163.com/~chunpeng/project/Export.zip 点这里下载原程序文件。  

  '请先引用ADODB类库。

  Dim Export_Str, mdbTable As String

  Dim rsExport As New ADODB.Recordset

  Dim conn As New ADODB.Connection

  Private Sub Close_cmd_Click()

  Unload Me

  End Sub

  

  Private Sub EXport_cmd_Click()

  Dim myPath, myStr As String, myPos As Integer

  '******************处理选择的各种表的导出

  With Dialog1

  If myOption(2).Value Then

  .FilterIndex = 1

  .ShowSave

  myStr = StrReverse(.FileName) '串取反

  myPos = InStr(myStr, "\") '在反字符串中,找从左开始第一个\的位置

  On Error GoTo myError '防FILENAME为空,MID出错

  myPath = StrReverse(Mid(myStr, myPos)) '取目录部分,并还原.

  myStr = StrReverse(Left(myStr, myPos - 1)) '取文件名

  Export_Str = "select * into [dBase III;database=" & myPath & "]." & myStr & " from Customers"

  .DefaultExt = "*.DBF"
  

  ElseIf myOption(3).Value Then

  mdbTable = InputBox("请给导出到MDB文件的表确定表名")

  .FilterIndex = 2

  .ShowSave

  Export_Str = "select * into [;database=" & .FileName & "]." & mdbTable & " from Customers"

  .DefaultExt = "*.MDB" 

  ElseIf myOption(4).Value Then

  .FilterIndex = 3

  .ShowSave

  Export_Str = "select * into [Excel 8.0;database=" & .FileName & "].Customers from Customers"

  .DefaultExt = "*.XLS"  

  ElseIf myOption(5).Value Then

  .FilterIndex = 4

  .ShowSave

  myStr = StrReverse(.FileName) '串取反

  myPos = InStr(myStr, "\") '在反字符串中,找从左开始第一个\的位置

  On Error GoTo myError '防FILENAME为空,MID出错

  myPath = StrReverse(Mid(myStr, myPos)) '取目录部分,并还原.

  myStr = StrReverse(Left(myStr, myPos - 1)) '取文件名

  Export_Str = "select * into [Paradox 4.X;database=" & myPath & "]." & myStr & " from Customers"

  .DefaultExt = "*.DB"

  End If

  End With
  

  '*****生成文件

  Debug.Print Export_Str

  If rsExport.State = 1 Then

  rsExport.Close

  End If 

  If Dir(Dialog1.FileName) <> "" Then

  On Error GoTo myError '防用户没选文件

  If Dialog1.FilterIndex <> 2 Then

  Kill (Dialog1.FileName)

  End If

  rsExport.Open Export_Str, conn, adOpenStatic, adLockOptimistic

  Else

  rsExport.Open Export_Str, conn, adOpenStatic, adLockOptimistic

  End If

  myError:

  Exit Sub

  End Sub  

  Private Sub Form_Load()

  '联接数据库并打开记录集

  conn.CursorLocation = adUseServer

  conn.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\NWind.mdb;"

  rsExport.Open "select *from Customers", conn, adOpenStatic, adLockOptimistic

  Set Grid1.DataSource = rsExport

  '初始化对话筐

  With Dialog1

  .Filter = "FoxBase/FoxPro (*.DBF) *.DBF Access 8.0(*.MDB) *.MDB Excel 8.0(*.XLS) *.XLS Paradox 4.x(*.DB) *.DB"

  .DialogTitle = "导出文件为"

  .CancelError = False

  End With

  End Sub

 

发表回复
你还没有登录,请先登录注册