作者 | 主题 |
---|---|
zhangli0 版主 经验值:46270 发帖数:16691 精华帖:61 |
楼主 2023-07-23 09:14:45
主题:博图wincc中遍历文件夹以及子文件夹下所有Excel的xlsm格式的文件的数据并写入到sql数据库的三个表中 Sub filecount(ByRef spath) '提示: ' 1. 使用 <CTRL+SPACE> 或 <CTRL+I> 快捷键打开含所有对象和函数的列表 ' 2. 使用 HMI Runtime 对象写入代码。 ' 示例:HmiRuntime.Screens("Screen_1")。 ' 3. 使用 <CTRL+J> 快捷键创建对象引用。 '从此位置起写入代码: Dim i,oFso,oFolder,oSubFolders,oSubFolder,oFiles,oFile,FileName'文件 Dim fso,myfile,ObjExcelApp'excel Dim mydata(21)'excel中的数据 Dim SecRes_limit,PHA_limit Dim conn,rst1,rst2,rst3,sel1,sel2,sel3,mysql1,mysql2,mysql3'数据库 On Error Resume Next Set oFso=CreateObject("s cripting.FileSystemObject") Set oFolder=oFso.GetFolder(spath) Set oSubFolders=oFolder.SubFolders Set oFiles=oFolder.Files For Each oFile In oFiles If Right(oFile.Path,4)="xlsm" Then FileName=oFile.Path HmiRuntime.Screens("数据导入").ScreenItems("文本域_15").Text=FileName&Chr(10)& HmiRuntime.Screens("数据导入").ScreenItems("文本域_15").Text Set fso = CreateObject("s cripting.FileSystemObject") Set ObjExcelApp = CreateObject("Excel.Application") ObjExcelApp.Visible =False ObjExcelApp.Workbooks.Open FileName '焊枪数据 mydata(1)=CStr(ObjExcelApp.Worksheets ("Chinesisch").Cells(4, 1).VAlue)'PaperNo mydata(2)=CStr(ObjExcelApp.Worksheets ("Chinesisch").Cells(4, 4).VAlue)'GunID mydata(3)=CStr(ObjExcelApp.Worksheets ("Chinesisch").Cells(4, 7).VAlue)'GunManualFactorial mydata(4)=CStr(ObjExcelApp.Worksheets ("Chinesisch").Cells(4, 13).VAlue)'GunTypes mydata(5)=CDbl(ObjExcelApp.Worksheets ("Chinesisch").Cells(4, 17).VAlue)'Weight_Kg mydata(6)=CStr(ObjExcelApp.Worksheets ("Chinesisch").Cells(4, 19).VAlue)'productdate '驱动电机数据 mydata(7)=CStr(ObjExcelApp.Worksheets ("Chinesisch").Cells(6, 1).VAlue)'DriverManualFactorial mydata(8)=CStr(ObjExcelApp.Worksheets ("Chinesisch").Cells(6, 4).VAlue)'Driver_Type mydata(9)=CStr(ObjExcelApp.Worksheets ("Chinesisch").Cells(6, 7).VAlue)'DriverID '变压器数据 mydata(10)=CStr(ObjExcelApp.Worksheets ("Chinesisch").Cells(6,10).VAlue)'Trans_factory mydata(11)=CStr(ObjExcelApp.Worksheets ("Chinesisch").Cells(6, 13).VAlue)'TransType mydata(12)=CStr(ObjExcelApp.Worksheets ("Chinesisch").Cells(6, 16).VAlue)'TransID mydata(13)=CDbl(Left(ObjExcelApp.Worksheets ("Chinesisch").Cells(6, 19).VAlue,Len(ObjExcelApp.Worksheets ("Chinesisch").Cells(6, 19).VAlue)-4))
'焊枪数据 mydata(14)=CInt(ObjExcelApp.Worksheets ("Chinesisch").Cells(24, 12).VAlue)'F_Max mydata(15)=CDbl(Replace(Right(ObjExcelApp.Worksheets ("Chinesisch").Cells(57, 16).VAlue,3),",","."))'SetVolume_Main mydata(16)=CDbl(Replace(Right(ObjExcelApp.Worksheets ("Chinesisch").Cells(60, 16).VAlue,3),",","."))'SetVolume_Fixed
If CDbl(Replace(Right(ObjExcelApp.Worksheets ("Chinesisch").Cells(61, 16).VAlue,3),",",".")) >0.0 Then mydata(17)=CDbl(Replace(Right(ObjExcelApp.Worksheets ("Chinesisch").Cells(61, 16).VAlue,3),",","."))'SetVolume_Moving Else mydata(17)=0.0 End If
SecRes_limit=Split(ObjExcelApp.Worksheets ("Chinesisch").Cells(75, 16).VAlue,"-") mydata(18)=CStr(SecRes_limit(0))'Sec_res_LLimit mydata(19)=CStr(SecRes_limit(1))'Sec_res_HLimit PHA_limit=Split(ObjExcelApp.Worksheets ("Chinesisch").Cells(76,16).VAlue,"-") mydata(20)=CInt(PHA_limit(0))'PHA_LLmint mydata(21)=CInt(PHA_limit(1))'PHA_HLmint ObjExcelApp.DisplayAlerts = False ObjExcelApp.Workbooks.Close 0 ObjExcelApp.Quit Set ObjExcelApp = Nothing '''''''''''''''''''写数据到数据库''''''''''''''''''''''''''''''''' '如果数据库中没有数据则插入数据否则更新数据 mysql1="" '焊枪数据库 Set conn=CreateObject("ADODB.Connection") Set rst1=CreateObject("ADODB.Recordset") Set rst2=CreateObject("ADODB.Recordset") Set rst3=CreateObject("ADODB.Recordset") conn.Open "DSN=Gun_db;uid=sa;pwd=VWA_WGTSJ1_report;" sel1="SELECT [GunID] FROM [dbo].[WeldingGun] where GunID='"&mydata(2)&"'" Set rst1=conn.Execute(sel1) If Not(rst1.EOF And rst1.BOF) Then mysql1="UPDATE [dbo].[WeldingGun]"_ &" Set [GunID] ='"&mydata(2)&"'"_ &",[GunTypes] ='"&mydata(4)&"'"_ &",[PaperNo] ='"&mydata(1)&"'"_ &",[GunManualFactorial] ='"&mydata(3)&"'"_ &",[Weight_Kg] ="&mydata(5)_ &",[Motor_NO] = '"&mydata(9)&"'"_ &",[Trans_NO] = '"&mydata(12)&"'"_ &",[F_Max] ="&mydata(14)_ &",[Sec_res_HLimit]="&mydata(19)_ &",[Sec_res_LLimit]="&mydata(18)_ &",[PHA_HLmint]="&mydata(21)_ &",[PHA_LLmint]="&mydata(20)_ &",[SetVolume_Main] ="&mydata(15)_ &",[SetVolume_Fixed] ="&mydata(16)_ &",[SetVolume_Moving] ="&mydata(17)_ &",[productdate]='"&mydata(6)&"'"_ &" where GunID='"&mydata(2)&"'" Else mysql1="INSERT INTO [dbo].[WeldingGun]"_ &" ([GunID]"_ &",[Motor_NO]"_ &",[Trans_NO]"_ &",[GunTypes]"_ &",[PaperNo]"_ &",[GunManualFactorial]"_ &",[Weight_Kg]"_ &",[F_Max]"_ &",[Sec_res_HLimit]"_ &",[Sec_res_LLimit]"_ &",[PHA_HLmint]"_ &",[PHA_LLmint]"_ &",[SetVolume_Main]"_ &",[SetVolume_Fixed]"_ &",[SetVolume_Moving]"_ &",[productdate]"_ &")"_ &" VALUES"_ &"('"&mydata(2)&"'"_ &",'"&mydata(9)&"'"_ &",'"&mydata(12)&"'"_ &",'"&mydata(4)&"'"_ &",'"&mydata(1)&"'"_ &",'"&mydata(3)&"'"_ &","&mydata(5)_ &","&mydata(14)_ &","&mydata(19)_ &","&mydata(18)_ &","&mydata(21)_ &","&mydata(20)_ &","&mydata(15)_ &","&mydata(16)_ &","&mydata(17)_ &",'"&mydata(6)&"'"_ &")" End If
'如果查询语句不为空,开始查询 If mysql1<>"" Then HmiRuntime.Screens("数据导入").ScreenItems("文本域_15").Text=mysql1&Chr(10)& HmiRuntime.Screens("数据导入").ScreenItems("文本域_15").Text Set rst1=conn.Execute(mysql1) End If If Err.Number<>0 Then ShowSystemAlarm "ERROR #"&Err.Number&" "&Err.Des cription Err.Clear
End If
'驱动器数据 sel2="Select [DriverID] FROM [dbo].[Motor]where DriverID='"&mydata(9)&"'" Set rst2=conn.Execute(sel2) If Not(rst2.EOF And rst2.BOF) Then mysql2="UPDATE [dbo].[Motor]"_ &"Set [DriverID] = '"&mydata(9)&"'"_ &",[DriverManualFactorial] = '"&mydata(7)&"'"_ &",[Driver_Type]='"&mydata(8)&"'"_ &" WHERE DriverID='"&mydata(9)&"'" Else mysql2="INSERT INTO [dbo].[Motor]"_ &" ([DriverID]"_ &",[DriverManualFactorial]"_ &",[Driver_Type])"_ &" VALUES"_ &"('"&mydata(9)&"'"_ &",'"&mydata(7)&"'"_ &",'"&mydata(8)&"'"_ &")" End If '如果查询语句不为空,开始查询 If mysql2<>"" Then HmiRuntime.Screens("数据导入").ScreenItems("文本域_15").Text=mysql2&Chr(10)& HmiRuntime.Screens("数据导入").ScreenItems("文本域_15").Text Set rst2=conn.Execute(mysql2) End If
'变压器数据库 sel3="SELECT [TransID] FROM [WGTS_1_forVWA].[dbo].[Transformer] WHERE TransID='"&mydata(12)&"'" Set rst3=conn.Execute(sel3) If Not(rst3.EOF And rst3.BOF) Then mysql3=" UPDATE [dbo].[Transformer]"_ &" Set [TransID] = '"&mydata(12)&"'"_ &",[TransType] = '"& mydata(11)&"'"_ &",[TransPower_kW] ="&mydata(13)_ &",[Trans_factory] ='"&mydata(10)&"'"_ &" WHERE TransID='"&mydata(12)&"' " Else mysql3="INSERT INTO [dbo].[Transformer]"_ &"([TransID]"_ &",[TransType]"_ &",[TransPower_kW]"_ &",[Trans_factory]"_ &")"_ &" VALUES ("_ &"'"&mydata(12)&"'"_ &",'"&mydata(11)&"'"_ &","&mydata(13)_ &",'"&mydata(10)&"'"_ &")" End If '如果查询语句不为空,开始查询 If mysql3<>"" Then HmiRuntime.Screens("数据导入").ScreenItems("文本域_15").Text=mysql3&Chr(10)& HmiRuntime.Screens("数据导入").ScreenItems("文本域_15").Text Set rst3=conn.Execute(mysql3) End If
ShowSystemAlarm "焊枪信息保存完成"
rst1.close rst2.close rst3.close conn.close
Set rst1=Nothing Set rst2=Nothing Set rst3=Nothing Set conn=Nothing End If Next For Each oSubFolder In oSubFolders filecount(oSubFolder.Path) Next ShowSystemAlarm "count is over" End Sub
活到老,学到老!为了生活学习吧!
|