大家快来找错!!在线等!!

Question

Public Sub SaveExcel(sfile As String)
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
Set xlBook = xlApp.Workbooks.Add
'xlBook.SaveAs sfile     <---------先不要调用这一句.
Set xlSheet = xlBook.Worksheets(1)
xlSheet.Cells(1, 1) = "姓名"
xlSheet.Cells(1, 2) = "收信人地址"
xlSheet.Cells(1, 3) = "收信人邮编"
xlSheet.Cells(1, 4) = "寄信人地址"
xlSheet.Cells(1, 5) = "寄信人邮编"
Dim i As Integer
For i = 0 To frmmain.list.ListItems.Count - 1
xlSheet.Range("A" & Str(i + 2)).Value = frmmain.list.ListItems(i).SubItems(2)
xlSheet.Range("B" & Str(i + 2)).Value = frmmain.list.ListItems(i).SubItems(3)
xlSheet.Range("C" & Str(i + 2)).Value = frmmain.list.ListItems(i).SubItems(4)
xlSheet.Range("D" & Str(i + 2)).Value = frmmain.list.ListItems(i).SubItems(5)
xlSheet.Range("E" & Str(i + 2)).Value = frmmain.list.ListItems(i).SubItems(6)
Next i
xlBook.SaveAs sfile        '<-------------在这里调用
xlApp.Application.Quit
Set xlApp = noting
Set xlBook = noting
Set xlSheet = noting
End Sub

Answer 1

xlSheet.Range("E" & Str(i + 2)).Value = frmmain.list.ListItems(i).SubItems(6)
Next ixlBook.SaveAs sfile ' 这一句移到xlApp.Save 的上面
xlApp.Save xlBook

Answer 2

xlApp.Application.Quit ''已经 quit了， 下面的set ...noting 会找不到对象。
Set xlApp = noting
Set xlBook = noting
Set xlSheet = noting

Answer 3

在关闭以前用
xlApp.Save
就可以了
不必用
SaveAs

Answer 4

Public Sub SaveExcel(sfile As String)
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = FalseIf Dir(sfile) = "" Then              '<----
    Set xlBook = xlApp.Workbooks.Add '<----
    xlBook.SaveAs sfile              '<----
Else                                 '<----
    Set xlBook = xlApp.Workbooks.Open(sfile)
End IfSet xlSheet = xlBook.Worksheets(1)
xlSheet.Cells(1, 1) = "姓名"
xlSheet.Cells(1, 2) = "收信人地址"
xlSheet.Cells(1, 3) = "收信人邮编"
xlSheet.Cells(1, 4) = "寄信人地址"
xlSheet.Cells(1, 5) = "寄信人邮编"
Dim i As Integer
For i = 0 To frmmain.list.ListItems.Count - 1
xlSheet.Range("A" & Str(i + 2)).Value = frmmain.list.ListItems(i).SubItems(2)
xlSheet.Range("B" & Str(i + 2)).Value = frmmain.list.ListItems(i).SubItems(3)
xlSheet.Range("C" & Str(i + 2)).Value = frmmain.list.ListItems(i).SubItems(4)
xlSheet.Range("D" & Str(i + 2)).Value = frmmain.list.ListItems(i).SubItems(5)
xlSheet.Range("E" & Str(i + 2)).Value = frmmain.list.ListItems(i).SubItems(6)
Next ixlBook.Save  '<----Set xlApp = noting
Set xlBook = noting
Set xlSheet = noting
End Sub

Answer 5

数据倒入Excel可以参见Foxmail地址簿数据导出成.CSV文件的方法。.csv文件格式可以用记事本打开Foxmail导出的结果看看，Excel能打开这种格式的文件。此方法不用调用Excel，但是只能使用Excel的一个sheet。

Answer 6

Open "d:\address.csv" For Append As #1
Print #1, "姓名,收信人地址,收信人邮编,寄信人地址,寄信人邮编"
Print #1, "纪嫣然,雅湖小筑,123456,,100001"
Close #1用Excel打开Address.CSV文件，看看能不能满足你的要求。

Answer 7

Public Sub SaveExcel(sfile As String)
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = FalseIf Dir(sfile) = "" Then              '<----
    Set xlBook = xlApp.Workbooks.Add '<----
    xlBook.SaveAs sfile              '<----
Else                                 '<----
    Set xlBook = xlApp.Workbooks.Open(sfile)
End IfSet xlSheet = xlBook.Worksheets(1)
xlSheet.Cells(1, 1) = "姓名"
xlSheet.Cells(1, 2) = "收信人地址"
xlSheet.Cells(1, 3) = "收信人邮编"
xlSheet.Cells(1, 4) = "寄信人地址"
xlSheet.Cells(1, 5) = "寄信人邮编"
Dim i As Integer
For i = 0 To frmmain.List.ListItems.Count - 1
xlSheet.Range("A" & Str(i + 2)).Value = frmmain.List.ListItems(i).SubItems(2)
xlSheet.Range("B" & Str(i + 2)).Value = frmmain.List.ListItems(i).SubItems(3)
xlSheet.Range("C" & Str(i + 2)).Value = frmmain.List.ListItems(i).SubItems(4)
xlSheet.Range("D" & Str(i + 2)).Value = frmmain.List.ListItems(i).SubItems(5)
xlSheet.Range("E" & Str(i + 2)).Value = frmmain.List.ListItems(i).SubItems(6)
Next ixlBook.Save  '<----xlBook.Close
xlApp.Quit'Set xlApp = noting
'Set xlBook = noting
'Set xlSheet = noting
End Sub