使用VBScript將數據從WinCC Flex存儲到Excel文件

Question

正在嘗試使用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 

我無法判斷錯誤。請只做那些需要的。

Answer 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