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