VB数据保存问题
我用VB做了个程序将PLC的数据保存在Excel中,但是只能保存一次,保存第二次就出错,请高手指教,程序如下Dim xlApp As Excel.Application '定义EXCEL类
Dim xlBook As Excel.Workbook '定义工件簿类
Dim xlsheet As Excel.Worksheet '定义工作表类
Private Sub Command1_Click()
Open App.Path & "\data.xsl" For Append As #1
Print #1, Tab(A); Text2.Text; Tab(B); Text1.Text; Tab(C); Text3.Text; Tab(D); Text4.Text; Tab(E); Text5.Text
Close #1
End Sub
Private Sub Command2_Click() '打开EXCEL过程
'If Dir("D:\temp\测量数据保存.xml") = "" Then '判断EXCEL是否打开
Set xlApp = CreateObject("Excel.Application") '创建EXCEL应用类
xlApp.Visible = False '设置EXCEL不可见
Set xlBook = xlApp.Workbooks.Open("D:\temp\测量数据保存.xml") '打开EXCEL工作簿
Set xlsheet = xlBook.Worksheets(1) '打开EXCEL工作表
xlsheet.Activate '激活工作表
u = ActiveSheet.UsedRange.Rows.Count + 1
xlsheet.Cells(u, 1) = Text2.Text '给单元格u行1列赋值
xlsheet.Cells(u, 2) = Text1.Text '给单元格u行2列赋值
xlsheet.Cells(u, 3) = Format(Now, "mm-dd-yy") + " " + Format(Now, "hh:mm:ss") '给单元格u行3列赋值
xlsheet.Cells(u, 4) = Text4.Text '给单元格u行4列赋值
xlsheet.Cells(u, 5) = Text5.Text '给单元格u行5列赋值
xlBook.RunAutoMacros (xlAutoOpen) '运行EXCEL中的启动宏
'Else
'End If
xlBook.save
End Sub
Private Sub Command3_Click()
'If Dir("D:\temp\测量数据保存.xml") <> "" Then '由VB关闭EXCEL
'xlBook.RunAutoMacros (xlAutoClose) '执行EXCEL关闭宏
xlBook.Close (True) '关闭EXCEL工作簿
xlApp.Quit '关闭EXCEL
'End If
Set xlApp = Nothing '释放EXCEL对象
Set xlBook = Nothing
Set xlsheet = Nothing
End Sub
Private Sub Form_Load() '窗体参数设置
Timer1.Enabled = True '定时器被激活(Inteval间隔时间一定要设置)
MSComm1.PortOpen = True '串口通信打开
TimeDelay (500) '延时500
End Sub
Public Function LRC(str As String) As String '通用功能 计算校验码
C = 0
l = Len(str)
For C = C + 1 To l
c_data = Mid$(str, C, 2)
d_lrc = d_lrc + Val("&H" + c_data)
C = C + 1
Next C
If d_lrc > &HFF Then
d_lrc = d_lrc Mod &H100
End If
h_lrc = Hex(&HFF - d_lrc + 1)
If Len(h_lrc) > 2 Then
h_lrc = Mid(h_lrc, Len(h_lrc) - 1, 2)
End If
LRC = h_lrc
End Function
Private Sub Timer1_Timer() '定时器触发的专用子程序
Dim s1, s22, s3, s4, s5 As String
Dim s6, s7, s8, s9, s10, s11, s12, s13 As String
Dim s14, s15, s16, s17, s18, s19, s20, s21, s23, s24, s25, s26 As String
Dim s27, s28, s29, s30, s31, s32, s33, s34, s35, s36, s37, s38, s39, s40, s41, s42, s43, s44, s45, s46 As String
Dim s2 As String
Dim m1, m2, m3 As Byte
Dim counter As Integer
s2 = "010310000021" '读 D0开始的内容 01站号 03读寄存器-功能码 1000寄存器D0-地址号 0021字长-H进制
s3 = ""
s22 = LRC(s2) '校验码
s1 = ":" + s2 + s22 + Chr$(13) + Chr$(10) '读出内容 ：-字头 +功能码 +D0开始的寄存器内容 +校验码 +回车 +换行
MSComm1.InBufferCount = 0 '串口输入接收缓冲器字符数 0-为任意长度
MSComm1.Output = s1 '发送数据
s3 = WaitRS(MSComm1, vbCrLf, 200) '延时200ms
s4 = Mid$(s3, 8, 4) '从指定位置截取字符串 (字符串,起始位置,长度(二进制))
s5 = Val("&H" + s4) 'H进制转十进制
s6 = Mid$(s3, 12, 4)
s7 = Val("&H" + s6)
s8 = Mid$(s3, 16, 4)
s9 = Val("&H" + s8)
s10 = Mid$(s3, 20, 4)
s11 = Val("&H" + s10)
s12 = Mid$(s3, 24, 4)
s13 = Val("&H" + s12)
s14 = Mid$(s3, 28, 4)
s15 = Val("&H" + s14)
s16 = Mid$(s3, 32, 4)
s17 = Val("&H" + s16)
s18 = Mid$(s3, 36, 4)
s19 = Val("&H" + s18)
s20 = Mid$(s3, 40, 4)
s21 = Val("&H" + s20)
s23 = Mid$(s3, 44, 4)
s24 = Val("&H" + s23)
s25 = Mid$(s3, 48, 4)
s26 = Val("&H" + s25)
s27 = Mid$(s3, 52, 4)
s28 = Val("&H" + s27)
s29 = Mid$(s3, 88, 4)
s30 = Val("&H" + s29)
s31 = Mid$(s3, 92, 4)
s32 = Val("&H" + s31)
s33 = Mid$(s3, 96, 4)
s34 = Val("&H" + s33)
s35 = Mid$(s3, 100, 4)
s36 = Val("&H" + s35)
s37 = Mid$(s3, 104, 4)
s38 = Val("&H" + s37)
s39 = Mid$(s3, 108, 4)
s40 = Val("&H" + s39)
s41 = Mid$(s3, 112, 4)
s42 = Val("&H" + s41)
s45 = Mid$(s3, 120, 4)
s46 = Val("&H" + s45)
Text2.Text = str(s5) + str(s7) + str(s9) + str(s11) + str(s13) + str(s15) + str(s17) + str(s19) + str(s21) + str(s24) + str(s26)
Text1.Text = str(s28)
Text3.Text = Format(Now, "yy-mm-dd") + " " + Format(Now, "hh:mm:ss")
Text4.Text = str(s42)
Text5.Text = str(s46)
s2 = "010108000002" '读 M0 状态 (2个位)
s3 = ""
s22 = LRC(s2) '校验码
s1 = ":" + s2 + s22 + Chr$(13) + Chr$(10) '读出内容 ：-字头 +功能码 +M0内部继电器状态 +校验码 +回车 +换行
MSComm1.InBufferCount = 0 '串口输入接收缓冲器字符数 0-为任意长度
MSComm1.Output = s1 '发送数据
s3 = WaitRS(MSComm1, vbCrLf, 200) '延时200ms
If s3 = "" Then Exit Sub
s4 = Mid$(s3, 8, 2) And &H1 '从指定位置截取字符串 (字符串,起始位置,长度(二进制))
If s4 = "1" Then 's4为ON
M0flag = 1 'M0标志就赋值为ON
Else: If s4 = "0" Then M0flag = 0 '反之s4为OFF，M0标志就为OFF
End If
If M0flag = 1 Then 'M0标志为ON
Shape1.FillColor = RGB(0, 255, 0) '灯显示绿色
Else '反之M0标志为OFF
Shape1.FillColor = RGB(255, 0, 0) '灯显示红色
End If
End Sub
