Vbscript添加新的工作表并不起作用

时间:2016-07-11 16:26:27

标签: excel excel-vba vba

我创建了Delmia Vbscript,将一些数据导出到Excel文件中。每次运行此程序时,都应该在同一个Excel文件中添加一个新的工作表,以便在单独的表中添加新值。我的代码的问题是,除了第一次运行程序时,Woorksheet对象是Nothing,并且值不会保存在Excel文件中。

Option Explicit

Dim objGEXCELapp        As Excel.Application
Dim objGEXCELwkBk       As Excel.Workbook
Dim objGEXCELSh         As Excel.Worksheet

Dim strFileName         As String
Dim strNewFilePath      As String

Sub CATMain()

StartEXCEL

Dim i
For i = 0 To body.NumberOfSegments - 1
    Dim segment As SWKSegment
    Set segment = body.GetSegment(i)

        WriteInExcel i + 1, 1, segment.Name
        WriteInExcel i + 1, 2, segment.FullName
        WriteInExcel i + 1, 3, segment.PositionX
        WriteInExcel i + 1, 4, segment.EndPositionX
        WriteInExcel i + 1, 5, segment.PositionY
        WriteInExcel i + 1, 6, segment.EndPositionY
        WriteInExcel i + 1, 7, segment.PositionZ
        WriteInExcel i + 1, 8, segment.EndPositionZ
        WriteInExcel i + 1, 9, segment.Length

   Next

  Dim file
  file = Dir("C:\temp\ExportData.xls")
  If Len(file) = 0 Then
  objGEXCELwkBk.SaveAs strNewFilePath
  Else
objGEXCELwkBk.Save
End If
objGEXCELwkBk.Close
objGEXCELapp.Quit

End Sub

这里有创建新的woorksheet的方法

Sub StartEXCEL()

Err.Clear
On Error Resume Next
Set objGEXCELapp = GetObject(, "EXCEL.Application")
If Err.number <> 0 Then
 Err.Clear
 Set objGEXCELapp = CreateObject("EXCEL.Application")
End If


objGEXCELapp.Application.Visible = True

Set objGEXCELwkBk = objGEXCELapp.Workbooks.Open(strNewFilePath)
If Err.number <> 0 Then
    Set objGEXCELwkBk = objGEXCELapp.Workbooks.Add
    Err.Clear
End If

objGEXCELwkBk.Worksheets.Add (After = objGEXCELwkBk.Worksheets.Count)
Set objGEXCELSh = objGEXCELwkBk.Worksheets(objGEXCELwkBk.Worksheets.Count)

End Sub

1 个答案:

答案 0 :(得分:0)

在代码的开头为strNewPath分配一个值:

Sub CATMain()
   strNewPath = "C:\temp\ExportData.xls"
   Call StartEXCEL