| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 5500 人关注过本帖
标题:.xls文件如何转成.dat文件
只看楼主 加入收藏
Joforn
Rank: 6Rank: 6
等 级:贵宾
威 望:23
帖 子:1242
专家分:122
注 册:2007-1-2
收藏
得分:0 

Option Explicit

Private Filename As String, Busy As Boolean
Private xlApp As Object, xlBook As Object, xlSheet As Object

Private Sub Command1_Click()

On Error Resume Next
CommonDialog1.ShowOpen

If Len(CommonDialog1.Filename) Then
Filename = CommonDialog1.Filename
Text1.Text = Filename
' OLE1.Delete'
' OLE1.CreateLink Filename
Set xlApp = CreateObject("Excel.Application") '创建EXCEL对象
Set xlBook = xlApp.WorkBooks.Open(Filename) '打开已经存在的EXCEL工件簿文件
xlApp.Visible = False '设置EXCEL对象可见(或不可见)
Set xlSheet = xlBook.Worksheets("Sheet1") '设置活动工作表,sheet1表示表名,可以使用字符型变量代替。
OLE1.CreateEmbed Filename
xlSheet.Activate '激活工作表,让它处于前台活动中。
End If
End Sub

Private Sub Command2_Click()
Dim I As Long, K As Long, TempStr As String, FileL As Long

On Error GoTo Error0

Busy = True
If (xlApp Is Nothing) Or (xlBook Is Nothing) Or (xlSheet Is Nothing) Then
MsgBox "你还未打开文件,请先打开一个Excel文档。": Exit Sub
End If
FileL = FreeFile
TempStr = Left(Filename, Len(Filename) - 3) & "dat"
Open TempStr For Binary As #FileL
K = xlSheet.Range("A65535").End(-4162&).Row
For I = 0 To 3
Label2(I).Visible = True
Next
For I = 1 To K
TempStr = xlSheet.Cells(I, 1) & " , " & xlSheet.Cells(I, 2).Value & vbCrLf
Put #FileL, , TempStr
Label2(2).Caption = I
Label2(3).Caption = (K - I) & "行"
DoEvents
Next I
Close #FileL
If MsgBox("生成Dat文件成功!是否关闭被打开的Excel文档?", vbYesNo, "Joforn") = vbYes Then
Set xlSheet = Nothing
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing
OLE1.Delete
End If
For I = 0 To 3
Label2(I).Visible = False
Next
Busy = False: Exit Sub
Error0:
MsgBox "错误:" & vbCrLf & " 写入文件错误或是打开的Excel文档已被关闭!", vbCritical, "错误提示"
On Error Resume Next
Set xlSheet = Nothing
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing
Busy = False
OLE1.Delete
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If Busy Then
MsgBox "程序正在处理文件,请稍候退出!", vbCritical, "退出程序"
Cancel = Busy
ElseIf Not (xlApp Is Nothing) Then
xlApp.Quit
Set xlApp = Nothing
End If
End Sub


VB QQ群:47715789
2007-06-01 17:18
kurosawa
Rank: 1
等 级:新手上路
帖 子:17
专家分:0
注 册:2007-5-27
收藏
得分:0 

谢谢~~~

2007-06-01 17:26
快速回复:.xls文件如何转成.dat文件
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.025188 second(s), 7 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved