vb操作文件夹多电子表格添加数据到数据库

server/2024/10/22 15:42:56/

Private Sub 批量文件夹导入_Click()

If MsgBox(" 1程序文件夹内必须有五险一金文件夹. 2五险一金里面表格名称开头前六位格式必须是 202401 202512 的日期格式 3表格里面字段名称必须和数据库字段相同 4必须是 A列工号 B列姓名 D列身份证 …顺序！ 5程序启动后不动鼠标 “, vbYesNo + 64, “强烈提示！”) = vbNo Then GoTo l
Dim xlApp As New Excel.Application '定义并创建EXCEL对象
Dim I As Integer
Dim zd3 As Object
Set zd3 = CreateObject(“scripting.dictionary”)
Dim ger As New Excel.Workbook '创建工作簿
STRSQL = “Select * From xjsdb where 序号=1”
RST.Open STRSQL, CNN, 1, 3
For I = 0 To RST.Fields.Count - 1
huwei1 = RST.Fields(I).Name
If Not zd3.Exists(huwei1) Then
zd3.Add huwei1, huwei1
End If
Next I
RST.Close
Dim sfzh, gjz As String
xlApp.DisplayAlerts = False
'xlApp.Visible = True '让Excel可见
Dim fso As Object, fd As Object, f As Object
Set fso = CreateObject(“Scripting.FileSystemObject”)
Set fd = fso.GetFolder(App.Path & “/五险一金”)
For Each f In fd.Files
'这里是对遍历出的每个文件进行操作
'其中f.Name是文件名，f.Path是文件路径，
'f.Size是文件大小，f.Type是文件类型，等等
'为了防止卡顿，可以在这个循环里用下面这行：
'DoEvents
bg = bg + 1
wjm = f.Name
yf = Val(Left(wjm, 4)) & “-” & Mid(wjm, 5, 2)
rq = yf & “-20”
Set ger = xlApp.Workbooks.Open(App.Path & “/五险一金/” & wjm) ‘打开个人表
ZUIHYIH = Sheets(1).Range(“a” & Rows.Count).End(xlUp).Row
For I = 2 To ZUIHYIH
If ger.ActiveSheet.Range(“a” & I & “”) = “” Then GoTo ll
rw = ger.ActiveSheet.Range(“b” & I & “”)
SFZ = ger.ActiveSheet.Range(“d” & I & “”)
STRSQL = “Select * From xjsdb where 证件号码= '” & SFZ & "’ and 年月 = '” & rq & "’ "
RST.Open STRSQL, CNN, 1, 3
If Not RST.EOF And Not RST.BOF Then
'aa = 1
Else
RST.AddNew
RST.Fields(“年月”) = rq
RST.Fields(“工号”) = ger.ActiveSheet.Range(“a” & I & “”)
RST.Fields(“姓名”) = ger.ActiveSheet.Range(“b” & I & “”)
RST.Fields(“证件号码”) = SFZ
End If
For ii = 5 To 22
huwei1 = ger.ActiveSheet.Cells(1, ii)
If Not zd3.Exists(huwei1) Then
If huwei1 = “失业保险费” Then
RST.Fields(“失业保险金”) = Val(ger.ActiveSheet.Cells(I, ii))
End If
If huwei1 = “企业(职业)年金” Then
RST.Fields(“企业职业年金”) = Val(ger.ActiveSheet.Cells(I, ii))
End If
Else
'DD = ger.ActiveSheet.Range(Cells(I, ii), Cells(I, ii))
RST.Fields(huwei1) = Val(ger.ActiveSheet.Cells(I, ii))
End If
Next ii
RST.Update
RST.Close
ll:
Next I