VB把数据保存到EXCEL

[单剑客]

我想帮串口接收到得数据保存到EXCEL里面，写到这里不知道怎么写了，就是想让MSComm触发的时候把收到的数据写到EXCEL里去，现在我只能用手动发过去，还不能换行，不能保存，能不能让VB控制EXCEL的保存，保存到指定的路径，文件名为保存时间2011.06.13/11，第一行自动写成序号，名称等，让数据从地2行开始保存。
Option Explicit
Dim xlapp As Variant
Dim xlBook As Variant
Dim xlSheet As Variant
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer
Dim e As Integer
Dim f As Integer
Dim g As Integer
Private Sub Command1_Click()
a = a + 2
b = b + 3
c = c + 4
d = d + 5
e = e + 6
f = f + 7
g = g + 8
xlSheet.Cells(2, a) = Text2.Text
xlSheet.Cells(2, b) = Text3.Text
xlSheet.Cells(2, c) = Text4.Text
xlSheet.Cells(2, d) = Text5.Text
xlSheet.Cells(2, e) = Text6.Text
xlSheet.Cells(2, f) = Text7.Text
xlSheet.Cells(2, g) = Text8.Text

End Sub

Private Sub Form_Load()
Set xlapp = CreateObject("excel.application")
xlapp.Visible = True
Set xlBook = xlapp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
MSComm1.Settings = "9600,n,8,1"
MSComm1.CommPort = 3
MSComm1.NullDiscard = False
MSComm1.RThreshold = 57
MSComm1.InputMode = comInputModeText
MSComm1.PortOpen = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
xlapp.Quit '关闭EXCEL
Set xlapp = Nothing '释放EXCEL对象
End Sub




Private Sub MSComm1_OnComm()

Text1.Text = MSComm1.Input
Text2.Text = Mid(Text1, 6, 10)
Text3.Text = Mid(Text1, 17, 8)
Text4.Text = Mid(Text1, 33, 6)
Text5.Text = Mid(Text1, 39, 3)
Text6.Text = Mid(Text1, 44, 2)
Text7.Text = Mid(Text1, 49, 4)
Text8.Text = Mid(Text1, 54, 2)
End Sub

[cqq_chen]

xlBook.saveas :...........

录制一个宏，看看代码就行。

如果要自动保存，写成订时保存就行，比如定义一下timeer，然后时间到就保存
！

[manpuku]

除了用VBA以外还有另外一个方法,VBA优势在于可以设置格式字体等等如果只需要数据录入可以试试使用SQL语句把excel表当作是一个数据库进行操作，不过这样只能添加修改数据不能删除

具体方法是先在某个指定位置保存一个空的excel表格，然后使用时调用文件复制的那个函数把它复制到想保存的位置，再使用ADO添加数据

可以看下面的例子

Private Sub mnuEXCEL_Click()
    Dim IOFilename As String
    Dim str As String
    Dim cn1 As New ADODB.Connection
    Dim cmd1 As New ADODB.Command
    Dim rs1 As New ADODB.Recordset
    Dim tmpPwd As String
    Dim tmpPwd2 As String
    tmpPwd2 = UCase(MD5(txtPassWord.Text))
    Debug.Print "导出ecxel密码框     " & tmpPwd2
    tmpPwd = sysRead("PASSWORD")
        Debug.Print "导入excel密码   " & tmpPwd
    If tmpPwd = tmpPwd2 Then
        If Dir(txtPatch.Text) <> "" Then            '检查文件是否存在
            txtPassWord.Text = ""
            On Error GoTo errClose
            FSO.CopyFile App.Path & "\backup\book.xls", App.Path & "\book.xls", True
            On Error GoTo errHandle
            cn1.Open JetOLEDB & txtPatch.Text
            cmd1.ActiveConnection = cn1
            cmd1.CommandType = adCmdText
            rs1.CursorLocation = adUseClient
            rs1.CursorType = adOpenStatic
            rs1.LockType = adLockOptimistic
'            str = "select tele_code as 号码,username as 姓名,department as 单位,address as 地址,remark as 备注 from tele"
            str = "select tele_code as 号码,username as 姓名,department as 单位,address as 地址,remark as 备注 into [excel 8.0;database=" & App.Path & "\book.xls].号码 from tele"
            cmd1.CommandText = str
            rs1.Open cmd1
            
            codPatch.DialogTitle = "另存为"
            codPatch.CancelError = True
            On Error GoTo errexit
            codPatch.InitDir = App.Path
            codPatch.Filter = "excel文件(*.xls)|*.xls"
            codPatch.ShowSave
            IOFilename = codPatch.FileName
            
            FSO.CopyFile App.Path & "\book.xls", IOFilename, True

            Open App.Path & "\record.log" For Append As #1
            Print #1, Format(Date, "YYYY-MM-DD") & "   " & Format(Time, "HH:MM:SS") & "     导出excel文件"
            Close #1
            cn1.Close
        Else
            MsgBox "数据库不存在请检查路径"
            Exit Sub
        End If
    Else
        MsgBox "密码错误！"
        Exit Sub
    End If
    Exit Sub
errClose:
    MsgBox "导出失败，请检查是否关闭文件" & App.Path & "\book.xls"
    Exit Sub
errHandle:
    Open App.Path & "\err.log" For Append As #2
    Print #2, Format(Date, "YYYY-MM-DD") & "   " & Format(Time, "HH:MM:SS") & "     导出excel失败：错误" & Err.Number & "---" & Err.Description
    Close #2
    Exit Sub
errexit:
    Exit Sub
End Sub