使用VBScript将数据从WinCC Flex存储到Excel文件

时间:2013-05-09 10:34:44

标签: excel vbscript wincc

尝试使用VB脚本将WinCC Flex的某些标签数据记录到Excel文件中。 我在西门子论坛上搜索过,并根据我的需要获得了一个脚本。 但是在WinCC Flex中执行脚本时出错。

脚本如下:

Dim wsh, XLSrunning, TargetBookrunning, objExcelApp, objWorkbook, TheTargetBook,    TheTargetBookName
Dim TheCount
Dim objFSO
Const OverwriteExisting = 1


Set wsh = CreateObject("WScript.Shell")
    TheTargetBookName = "report.xls"
    TheTargetBook = "D:\Out\" & TheTargetBookName

'---------------[Modification#1_Begin]-------------------------------------------
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FileExists(TheTargetBook) Then
       objFSO.CopyFile "D:\Out\Template.xls", TheTargetBook, OverwriteExisting
       'HMIRuntime.Trace "The file," & TheTargetBook & ", does not exist." & vbCrLf & "I've just created one for you!"
End If
Set objFSO = Nothing    

'---------------[Modification#1_End]--------------------------------------------

TheCount = GetObject("winmgmts:root\CIMV2").ExecQuery("SELECT * FROM Win32_Process WHERE Name='EXCEL.EXE'").Count   
'While TheCount is bigger than 0, it means the Excel Application is running..., but doesn't mean the workbook is open for sure!

If TheCount > 0 Then
   Set objExcelApp = GetObject(,"Excel.Application")
                 ' Using GetObject(,"Excel.Application") to point to the running Excel Application.

       TargetBookrunning = 0  
       For Each XLSrunning In objExcelApp.Workbooks
           If XLSrunning.name = TheTargetBookName Then
              TargetBookrunning = 1
           End If
       Next
       If TargetBookrunning = 1 Then
          Set objWorkbook = GetObject(TheTargetBook)
       Else
          Set objWorkbook = objExcelApp.Workbooks.Open(TheTargetBook)
       End If
Else

  Set objExcelApp = CreateObject("Excel.Application")
  Set objWorkbook = objExcelApp.Workbooks.Open(TheTargetBook)

End If

      objExcelApp.Visible = True
      objExcelApp.ScreenUpdating = True
      objExcelApp.DisplayAlerts = True

      Dim TheTargetRow       ' <------[Modification#2]-------
      With objWorkbook.ActiveSheet

        TheTargetRow = .Cells(65535, 2).End(-4162).Row
                .cells(TheTargetRow + 1, 2) = SmartTags("Tag_1")
                .cells(TheTargetRow + 1, 3) = SmartTags("Tag_2")
                .cells(TheTargetRow + 1, 4) = SmartTags("Tag_3")         

      End With 
      objWorkbook.Save
     'objWorkbook.Close

  Set objWorkbook = Nothing
     'objExcelApp.Quit
  Set objExcelApp = Nothing
  'MsgBox "Done"

Set wsh = Nothing   

当我尝试执行此脚本时,编译器会在以下行中显示错误:

 TheTargetRow = .Cells(65535, 2).End(-4162).Row

我无法确定错误。请做好。

1 个答案:

答案 0 :(得分:1)

您显示的代码大多是正确的,但实际上该行中的问题与WINCC环境中VBScript接口的实现有关。

如果您创建了一个名为“theSheet”的新变量来保存对Excel的引用 在工作表中,您仍然可以避免WinCC中的语法检查问题。

这种方式允许你从它访问它的Cells对象,但在我看来,没有一种明显的方法可以直接返回“.End(xlUp).Row”属性的值。

但是,“行”值的唯一目的是获取行号以打印标记值。检查下一个代码,看看你对结果的感受。

Dim wsh, XLSrunning, TargetBookrunning, objExcelApp, objWorkbook, TheTargetBook, TheTargetBookName
Dim TheCount, theSheet, theCell, theLastCell,  theLastRow
Dim objFSO
Const OverwriteExisting = 1


Set wsh = CreateObject("WScript.Shell")
    'TheTargetBookName = "report.xls"
    'TheTargetBook = "D:\Out\" & TheTargetBookName

    TheTargetBookName = "report.xls"
    TheTargetBook = "f:\work\plc\" & TheTargetBookName
    TheTargetBookName = "c:\" & TheTargetBookName

'---------------[Modification#1_Begin]-------------------------------------------
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FileExists(TheTargetBook) Then
       objFSO.CopyFile TheTargetBookName, TheTargetBook, OverwriteExisting
       'HMIRuntime.Trace "The file," & TheTargetBook & ", does not exist." & vbCrLf & "I've just created one for you!"
End If
Set objFSO = Nothing    

'---------------[Modification#1_End]--------------------------------------------

TheCount = GetObject("winmgmts:root\CIMV2").ExecQuery("SELECT * FROM Win32_Process WHERE Name='EXCEL.EXE'").Count   
'While TheCount is bigger than 0, it means the Excel Application is running..., but doesn't mean the workbook is open for sure!

If TheCount > 0 Then
   Set objExcelApp = GetObject(,"Excel.Application")
                 ' Using GetObject(,"Excel.Application") to point to the running Excel Application.

       TargetBookrunning = 0  
       For Each XLSrunning In objExcelApp.Workbooks
           If XLSrunning.name = TheTargetBookName Then
              TargetBookrunning = 1
           End If
       Next
       If TargetBookrunning = 1 Then
          Set objWorkbook = GetObject(TheTargetBook)
       Else
          Set objWorkbook = objExcelApp.Workbooks.Open(TheTargetBook)
       End If
Else

  Set objExcelApp = CreateObject("Excel.Application")
  Set objWorkbook = objExcelApp.Workbooks.Open(TheTargetBook)

End If

      objExcelApp.Visible = True
      objExcelApp.ScreenUpdating = True
      objExcelApp.DisplayAlerts = True

      Dim TheTargetRow       ' <------[Modification#2]-------
      Set theSheet = objWorkbook.ActiveSheet
      With theSheet
        Set theCell = theSheet.Cells(65535,2)
        Set theLastCell  = theCell.end(-4162)
        theLastRow = theLastCell.row
        .cells(theLastRow + 1, 1) = formatdatetime( now,vbShortDate) & ", " & formatdatetime( now,vbLongTime)
        .cells(theLastRow + 1, 2) = SmartTags("Tag_1")
        .cells(theLastRow + 1, 3) = SmartTags("Tag_2")
        .cells(theLastRow + 1, 4) = SmartTags("Tag_3")         
      End With 
      objWorkbook.Save
     'objWorkbook.Close

  Set objWorkbook = Nothing
     'objExcelApp.Quit  
  Set objExcelApp = Nothing
  'MsgBox "Done"

Set wsh = Nothing