如何将两个DBF文件导入到相应的工作薄对应的工作表中

yzyyyyyyy

zhaogang1960 发表于 2012-10-16 16:14
请说明下图三个按钮都写到哪个工作表：

导入学生库，写入到学生表中
导入家长库，写入到家长表中
导入合并库，写入到信息册表中

cxh2010

教育行业的事例，支持一下

zhaogang1960

1. Sub 导入学生库()
   
2.     Dim cnn As Object
   
3.     Dim SQL As String
   
4.     Dim s$
   
5.     Set cnn = CreateObject("ADODB.Connection")
   
6.     cnn.Open "Driver={Microsoft Visual FoxPro Driver};SourceType=DBF;SourceDB=" & ThisWorkbook.Path & ";Exclusive=No;"
   
7.     SQL = "select * from z221801"
   
8.     s = [J1]
   
9.     If s <> "" And s <> "全部" Then SQL = SQL & " where left(学籍编号,10) like '%" & s & "'"
   
10.     With Sheets("学生")
    
11.         .UsedRange.Offset(1).ClearContents
    
12.         .Range("A2").CopyFromRecordset cnn.Execute(SQL)
    
13.     End With
    
14.     cnn.Close
    
15.     Set cnn = Nothing
    
16. End Sub
    
17. 
    

复制代码

zhaogang1960

1. Sub 导入家长库()
   
2.     Dim cnn As Object
   
3.     Dim SQL As String
   
4.     Dim s$
   
5.     Set cnn = CreateObject("ADODB.Connection")
   
6.     cnn.Open "Driver={Microsoft Visual FoxPro Driver};SourceType=DBF;SourceDB=" & ThisWorkbook.Path & ";Exclusive=No;"
   
7.     SQL = "select * from zj221800"
   
8.     s = [J1]
   
9.     If s <> "" And s <> "全部" Then SQL = SQL & " where left(学籍编号,10) like '%" & s & "'"
   
10.     With Sheets("家长")
    
11.         .UsedRange.Offset(1).ClearContents
    
12.         .Range("A2").CopyFromRecordset cnn.Execute(SQL)
    
13.     End With
    
14.     cnn.Close
    
15.     Set cnn = Nothing
    
16. End Sub
    

复制代码

zhaogang1960

1. Sub 导入合并库()
   
2.     Dim cnn As Object, rs As Object
   
3.     Dim SQL As String, d As Object, arr(), i&, l&, j&, n&, t, s$
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     Set cnn = CreateObject("ADODB.Connection")
   
6.     cnn.Open "Driver={Microsoft Visual FoxPro Driver};SourceType=DBF;SourceDB=" & ThisWorkbook.Path & ";Exclusive=No;"
   
7.     Set rs = CreateObject("ADODB.Recordset")
   
8.     s = [J1]
   
9.     SQL = "select * from z221801"
   
10.     If s <> "" And s <> "全部" Then SQL = SQL & " where left(学籍编号,10) like '%" & s & "'"
    
11.     rs.Open SQL, cnn, 1, 3
    
12.     With Sheets("信息册")
    
13.         .UsedRange.Offset(1).ClearContents
    
14.         .Range("A2").CopyFromRecordset rs
    
15.         rs.MoveFirst
    
16.         ReDim arr(1 To rs.RecordCount, 1 To 12)
    
17.         For i = 1 To rs.RecordCount
    
18.             d(rs.Fields(0).Value) = i
    
19.             rs.MoveNext
    
20.         Next
    
21.         SQL = "select * from zj221800"
    
22.         If s <> "" And s <> "全部" Then SQL = SQL & " where left(学籍编号,10) like '%" & s & "'"
    
23.         Set rs = CreateObject("ADODB.Recordset")
    
24.         rs.Open SQL, cnn, 1, 3
    
25.         For i = 1 To rs.RecordCount Step 2
    
26.             n = 0
    
27.             For l = i To i + 1
    
28.                 t = d(rs.Fields(0).Value)
    
29.                 If t <> "" Then
    
30.                     For j = 1 To 6
    
31.                         arr(t, j + n) = rs.Fields(j).Value
    
32.                     Next j
    
33.                 End If
    
34.                 n = n + 6
    
35.                 rs.MoveNext
    
36.             Next l
    
37.         Next i
    
38.         .Range("o2").Resize(UBound(arr), 12) = arr
    
39.     End With
    
40.     rs.Close
    
41.     cnn.Close
    
42.     Set rs = Nothing
    
43.     Set cnn = Nothing
    
44. End Sub
    
45. 
    

复制代码

zhaogang1960

请注意，J1为空或全部就导入全部数据，否则加上学籍编号的第9、10两位条件
请看附件
如何将两个DBF文件导入到相应的工作薄对应的工作表中.rar (108.75 KB, 下载次数: 23)

2012-10-16 16:36 上传

点击文件名下载附件

yzyyyyyyy

感谢版主的再一次帮助，解决了一大难题。
目前导入合并库时，是导入全部字段，
如果再加一个按钮，导入学籍册
只导入以下字段，能行吗，除监护人姓名是zj221800.dbf中的外，其他全是z221800.dbf中的信息。监护人姓名，填写第一监护人姓名。
如果第一监护人姓名为“无”或空，则填写第二监护人姓名。仍然是先选择届级，再运行按钮。
学籍编号        姓名        "性别"        身份证号        "出生年月日"        民族        班级        家庭住址        "监护人姓名"        联系电话

zhaogang1960

yzyyyyyyy 发表于 2012-10-16 17:14
感谢版主的再一次帮助，解决了一大难题。
目前导入合并库时，是导入全部字段，
如果再加一个按钮，导入学 ...

我有阅读困难，还是模拟效果吧

zhaogang1960

1. Sub 导入学籍册()
   
2.     Dim cnn As Object, rs As Object
   
3.     Dim SQL As String, d As Object, arr(), i&, l&, j&, n&, t, s$
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     Set cnn = CreateObject("ADODB.Connection")
   
6.     cnn.Open "Driver={Microsoft Visual FoxPro Driver};SourceType=DBF;SourceDB=" & ThisWorkbook.Path & ";Exclusive=No;"
   
7.     Set rs = CreateObject("ADODB.Recordset")
   
8.     s = [J1]
   
9.     SQL = "select 学籍编号,姓名,性别,身份证号,出生年月,民族,班级,家庭住址,'',联系电话,备注 from z221801"
   
10.     If s <> "" And s <> "全部" Then SQL = SQL & " where left(学籍编号,10) like '%" & s & "'"
    
11.     rs.Open SQL, cnn, 1, 3
    
12.     With Sheets("学籍册")
    
13.         .UsedRange.Offset(3).ClearContents
    
14.         ReDim arr(1 To rs.RecordCount, 10)
    
15.         For i = 1 To rs.RecordCount
    
16.             d(rs.Fields(0).Value) = i
    
17.             For j = 0 To rs.Fields.Count - 1
    
18.                 If j <> 8 Then arr(i, j) = rs.Fields(j).Value
    
19.             Next j
    
20.             rs.MoveNext
    
21.         Next i
    
22.         SQL = "select 学籍编号,监护人 from zj221800"
    
23.         If s <> "" And s <> "全部" Then SQL = SQL & " where left(学籍编号,10) like '%" & s & "'"
    
24.         Set rs = CreateObject("ADODB.Recordset")
    
25.         rs.Open SQL, cnn, 1, 3
    
26.         For i = 1 To rs.RecordCount Step 2
    
27.             For l = i To i + 1
    
28.                 t = d(rs.Fields(0).Value)
    
29.                 If Len(arr(t, 8)) = 0 Then
    
30.                     If Len(rs.Fields(1).Value) And t <> "" Then arr(t, 8) = rs.Fields(1).Value
    
31.                 End If
    
32.                 rs.MoveNext
    
33.             Next l
    
34.         Next i
    
35.         .Range("a4").Resize(UBound(arr), 11) = arr
    
36.     End With
    
37.     rs.Close
    
38.     cnn.Close
    
39.     Set rs = Nothing
    
40.     Set cnn = Nothing
    
41. End Sub
    

复制代码

zhaogang1960

请看附件
如何将两个DBF文件导入到相应的工作薄对应的工作表中.rar (111.08 KB, 下载次数: 23)

2012-10-16 17:52 上传

点击文件名下载附件