Navigation
Make daily report from WinCC to Ms.Excel using VBScript (error to export data)
Created by: Frankyphs at: 4/14/2021 7:37 AM (2 Replies)
Rating 
Thanks 1
3 Entries
| 4/14/2021 7:37 AM | |
Joined: 12/22/2020 Last visit: 10/29/2021 Posts: 11 Rating:
|
Hi guys, now i am doing project making daily report automatically from Tia portal (Win CC RT) to Ms.Excel. Because i dont understand about VBScript, i copy the script from people on youtube. The script consist of 2 parts, named Create Script (to make folder) and Export Script (export data to excel). Below is the VBScript code : *Create Script Sub Create() Dim dtmDate, objExcel, objWorkbook, path Dim a Dim DT, CDT, VBDT, CWT, VBWT, CpHORP, CQT, VBQT, CFLDREX, VBFLDREX, CFLDRPDF, VBFLDRPDF, Cweb, VBWeb Dim DY, MNTH, YR, MNTHNM Dim HR, MNT, SCND Dim i,j Dim fso, mag, fldr, ReportFolderStatus Dim fsol, f, fName DY=Day(Date()) MNTH=Month(Date()) YR=Year(Date()) HR=Hour(Time()) MNT=Minute(Time()) SCND=Second(Time()) MNTHNM=Month(Now) MNTHNM=MonthName (MNTHNM,True) 'Define Month Type Dim MNTH1, DY1 If MNTH < 10 Then MNTH1 = "0" & MNTH Else MNTH1= MNTH End If 'Define Date Type If DY < 10 Then DY1 = "0" & DY Else DY1 = DY End If 'Define Hour & Minute Dim HR1, MNT1 'Hour If HR < 10 Then HR1 = "0" & HR Else HR1 = HR End If 'Minute If MNT < 10 Then MNT1 = "0" & MNT Else MNT1 = MNT End If 'SAVE LINK VBFLDREX = "D:\Report\" & YR & MNTH1 & DY1 VBDT= VBFLDREX & "\" & "report_" & YR & "_" & MNTH1 & "_" & DY1 & ".xls" '========== Create FOLDER =========== Set fsol = CreateObject ("Scripting.FileSystemObject") fsol.CreateFolder(VBFLDREX) '========== Create New FILE For Each SEQUENCE ======== Dim objFSO Dim RefFile Dim TarFile Set objFSO = CreateObject("Scripting.FileSystemObject") ' RefFile = "D:\Report\Reference\Report_Reference.xls" 'Reference FILE TarFile = VBDT 'First parameter : original location\FILE objFSO.CopyFile RefFile, TarFile End Sub *Export Script Sub Export() '==============SAVE LINK============ Dim dtmDate, path Dim a Dim objExcelApp2 Dim DT,CDT,VBDT,CWT,VBWT,CpHORP,VBpHORP,CQT,VBQT,CFLDREX,VBFLDREX,CFLDRPDF,VBFLDRPDF,Cweb,VBWeb Dim DY,MNTH,YR,MNTHNM Dim HR,MNT,SCND Dim i,j Dim fso, msg, fldr, ReportFolderStatus Dim fsol, f, fName DY=Day(Date()) MNTH=Month(Date()) YR=Year(Date()) HR=Hour(Time()) MNT=Minute(Time()) SCND=Second(Time()) MNTHNM=Month(Now) MNTHNM=MonthName (MNTHNM, True) 'Define Month Type Dim MNTH1, DY1 If MNTH < 10 Then MNTH1 = "0" & MNTH Else MNTH1 = MNTH End If 'Define Date Type If DY < 10 Then DY1 = "0" & DY Else DY1 = DY End If 'Define Hour & Minute Dim HR1, MNT1 'Hour If HR < 10 Then HR1 = "0" & HR Else HR1 = HR End If 'Minute If MNT < 10 Then MNT1 = "0" & MNT Else MNT1 = MNT End If '=======SAVE LINK VBFLDREX = "D:\Report\" & YR & MNTH1 & DY1 VBDT = VBFLDREX & "\" & "report_" & YR & "_" & MNTH1 & "_" & DY1 & ".xls" '=========SAVE LINK============== Dim wsh, XLSrunning, TargetBookrunning, objExcelApp, objWorkbook, TheTargetBook, TheTargetBookName Dim TheCount, TheTargetRow Dim objFSO Const OverwriteExisting = 1 Set wsh = CreateObject("Wscript.Shell") TheTargetBookName = VBDT TheTargetBook = TheTargetBookName '--------------------------------------- TheCount = GetObject("winmgmts:root\CIMV2").ExecQuery("Select * FROM Win32_Process WHERE Name=’EXCEL.EXE’ ").Count If TheCount > 0 Then Set objExcelApp = GetObject(,"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 = False objExcelApp.ScreenUpdating = True objExcelApp.DisplayAlerts = True Dim P100AtheTargetRow, P100BtheTargetRow ' -----------[Modification#2] With objWorkbook.activesheet '=================================MODIFICATION 'P100AtheTargetRow = .Cells(65535, 7).End(-4162).Row 'P100BtheTargetRow = .Cells(65535, 8).End(-4162).Row '.cells(TheTargetRow + 1, 2) = HMIRuntime.Screens("NewPd10").ScreenItems("IOField2").OutputValue '.cells(TheTargetRow + 1, 3) = HMIRuntime.Screens("NewPd10").ScreenItems("IOField2").OutputValue '.cells(TheTargetRow + 1, 4) = HMIRuntime.Screens("NewPd10").ScreenItems("IOField2").OutputValue '===Export DATA===== TheTargetRow = .Cells(65535, 6).End(-4162).Row .cells(TheTargetRow + 1, 2) = Date() & " " & Time() .cells(TheTargetRow + 1, 3) = Smarttags("TEMP") .cells(TheTargetRow + 1, 4) = Smarttags("PRESSURE") .cells(TheTargetRow + 1, 5) = Smarttags("CURRENT") .cells(TheTargetRow + 1, 6) = Smarttags("VOLTAGE") '======Export End=========== End With objWorkbook.Save objWorkbook.Close Set objWorkbook = Nothing objExcelApp.Quit Set objExcelApp = Nothing 'MsgBox "Done" Set wsh = Nothing End Sub
2. I make the name of excel file destination folder with the precise name on my PC : D:\Report\Reference\Report_Reference.xls
AttachmentTiaPortalToExcel.zip (532 Downloads) |
Follow us on