技术论坛

 博图wincc中遍历文件夹以及子文件夹下所有Excel的xlsm格式的文件的数据并写入到sql数据库的三个表中

返回主题列表
作者 主题
zhangli0
版主

经验值:43685
发帖数:15819
精华帖: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


活到老,学到老!为了生活学习吧!
您收到0封站内信:
×
×
信息提示
很抱歉!您所访问的页面不存在,或网址发生了变化,请稍后再试。