'On Error Resume Next Dim fileadd As String CommonDialog1.ShowOpen CommonDialog1.Filter = "xls文件(*.xls)|*.xls" '选择你要的文件 fileadd = CommonDialog1.FileName If fileadd = "" Then Exit Sub Set xlApp = CreateObject("Excel.Application") '创建EXCEL对象 Set xlBook = xlApp.Workbooks.Open(fileadd) '打开已经存在的EXCEL工件簿文件 xlApp.Visible = False ' = True '设置EXCEL对象可见(或不可见) Set xlSheet = xlBook.Worksheets(1) '设置活动工作表 For R = 1 To 99999 '行循环 If LTrim(RTrim(xlBook.Worksheets(1).Cells(R, 1))) <> "" Then sybw.Adodc3.Refresh sybw.Adodc3.Recordset.Find "ShiGongBuWei_Name='" & LTrim(RTrim(xlBook.Worksheets(1).Cells(R, 1))) & "'" If sybw.Adodc3.Recordset.EOF Then sybw.Adodc3.Recordset.AddNew sybw.Adodc3.Recordset!ShiGongBuWei_Name = LTrim(RTrim(xlBook.Worksheets(1).Cells(R, 1))) sybw.Adodc3.Recordset!FenXiangGongCheng_ID = bb sybw.Adodc3.Recordset.Update sybw.Adodc3.Refresh ' Call log(MM_Users_NameTrue, "增加了施工部位", MM_Companys_ID) Else ' MsgBox " 施工部位重复! ", vbOKOnly, "用户信息" End If Else R = 99999 + 1 End If Next R
xlApp.DisplayAlerts = False '不进行安全提示 ' Set xlSheet = Nothing ' Set xlBook = Nothing ' xlApp.Quit ' Set xlApp = Nothing