表A 含有如下两列
姓名 照片
在窗口写【批量导入】,代码见下。但有时会出现“未将对象引用设置到对象的实例” 的情况,不知啥原因?
(如下代码,我是想将D:\照片中的照片压缩至D:\FOXYS子目录(备份用),然后将压缩照片一起拷贝到项目Attachments目录下,最后分别根据姓名计入每行的照片列)
e.Form.Controls("b12").Text = "请稍等 "
If FileSys.DirectoryExists("d:\照片FOX") Then
If FileSys.DirectoryExists("d:\FOXYS") Then
FileSys.DeleteDirectory("D:\FOXYS",2,3)
End If
FileSys.CreateDirectory("d:\foxys")
For Each f As String In FileSys.GetFiles("d:\照片FOX")
Dim ifo As new FileInfo(f)
Dim name As String = ifo.name.Replace(ifo.Extension, "")
Dim file As String ="D:\照片FOX\" &ifo.Name
Dim img As image = getImage(file)
Dim bmp = new bitmap(img, 400, 400 * (img.height / img.width))
bmp.save ("d:\foxys\" & ifo.Name)
bmp.Dispose
Next
Dim pth As String = ProjectPath & "Attachments\"
FileSys.CopyDirectory ("D:\FOXYS", PTH, True)
For Each f As String In FileSys.GetFiles( ProjectPath & "Attachments\")
Dim ifo As new FileInfo(f)
Dim name As String = ifo.name.Replace(ifo.Extension, "")
Dim fdr As DataRow = DataTables("表B").Find("姓名 = '" & name & "'")
If fdr IsNot Nothing Then
fdr("照片") =Ifo.Name
End If
Next
MessageBox.Show("一键导入已完成","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
Else
e.Form.Controls("b12").Text = " "
MessageBox.Show("请将全部职工个人照片用对应姓名命名(格式.JPG,存放至D:\照片FOX 目录中,然后点击一键录入")
End If
e.form.Controls("Lab").Text = "【共 " & Tables("表B").rows.Count & " 位】"
Dim Count1 As Integer
Count1 = DataTables("表B").Compute("Count(姓名)","[照片] IS NOT NULL ")
If COUNT1 >0 Then
e.form.Controls("K").Text = "【有照片 " & count1 & " 位】"
End If
谢谢老师!