Private Sub Command38_Click()
Dim 照片文件夹路径 As String
照片文件夹路径 = CurrentProject.Path & "\照片\" '指定照片文件夹路径（也可以用模块级变量）
On Error GoTo 错误标签 '出错时转到错误标签
Dim 源文件 As Variant
Dim 目标文件 As String
Dim fDialog As FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
Dim vrtSelectedItem As Variant
With fDialog '调用Office文件对话框中的文件选取对话框
.Title = "选择照片" '设置对话框标题
.Filters.Clear '清除文件筛选器
.Filters.Add "All Files", "*.jpg" '重新设置筛选器
.AllowMultiSelect = False '禁止对话框多选
If .Show Then '如果对话框没有被取消
If IsNull(Me.id) Then Me.zhaopian = Null '给任意适合的字段赋值，以生成ID（添加的照片文件需要根据ID来重命名）
For Each vrtSelectedItem In .SelectedItems
源文件 = vrtSelectedItem
Next vrtSelectedItem '将取得的文件路径名保存到变量
目标文件 = 照片文件夹路径 & Me!id & ".jpg" '生成存放到照片文件夹中的文件名
If Dir(目标文件) <> "" Then '如果照片已存在
If MsgBox("照片已存在，是否替为新照片？", _
vbQuestion + vbYesNo, "确认") = vbYes Then '显示确认消息框，选择是否替换
Kill 目标文件 '如果选择“是”，则先删除已存在照片
Else
Exit Sub '否则退出过程不再处理
End If
End If
If Not 源文件 Like 照片文件夹路径 & "*" Then '如果源文件不是照片文件夹中的文件
FileCopy 源文件, 目标文件 '将选择的图片文件复制到照片文件夹
End If
Me!zhaopian.Picture = 目标文件 '将照片加载到图像控件
End If
End With
退出标签:
Exit Sub '退出过程
错误标签:
MsgBox Err.Description, vbCritical, "错误 #" & Err '出错时先显示错误消息框
Resume 退出标签 '然后转到退出标签
End Sub
