Office中国论坛/Access中国论坛

标题: 图片添加复制选择图片问题 [打印本页]

作者: totodon 时间: 2010-6-16 14:08
标题: 图片添加复制选择图片问题
Sub getFileName()
Dim FileName As String
Dim result As Integer
Dim Paths As String '
With Application.FileDialog(msoFileDialogFilePicker)
      .Title = "选择雇员照片"
      .Filters.Add "所有文件", "*.*"
      .Filters.Add "JPEGs", "*.jpg"
      .Filters.Add "位图文件", "*.bmp"
      .FilterIndex = 1
      .AllowMultiSelect = False
      .InitialFileName = CurrentProject.path
      result = .Show
      If (result <> 0) Then
         FileName = Trim(.SelectedItems.Item(1))
         Me![照片路径].Visible = True
         Me![照片路径].SetFocus
         Me![照片路径].Text = FileName
         错误信息.Visible = False
         Paths = CurrentProject.path       '获取路径
      If Dir(Paths & "\photo\", vbDirectory) = "" Then MkDir Paths & "\photo\" '检测文件夹photo是否存在
      FileCopy CurrentProject.path, Paths & "\photo\" & Me.姓名 & ".jpg"          '将选中文件重新命名后复制到photo文件夹中
      Me.照片路径 = Paths & "\photo\" & Me.姓名 & ".jpg"
      Me![照片图像].Picture = Me![照片路径]
         '照片路径上显示复制后的照片路径
      showImageFrame
      showErrorMessage
      End If
End With
End Sub

问题出在这里       FileCopy CurrentProject.path, Paths & "\photo\" & Me.姓名 & ".jpg"
就是提示要调试！

这是我写的代码！但是就是出现问题。请朋友你为我指点一下！我是在ACCESS上的VBA代码

作者: koutx 时间: 2010-6-17 10:07
本帖最后由 koutx 于 2010-6-17 10:39 编辑

Sub getFileName()
Dim FileName As String
Dim Fe As FileDialog
Set Fe = Application.FileDialog(msoFileDialogFilePicker)
Dim vrtSelectedItem As Variant
With Fe
      .Title = "选择雇员照片"
      .Filters.Add "所有文件", "*.*"
      .Filters.Add "JPEGs", "*.jpg"
      .Filters.Add "位图文件", "*.bmp"
      .FilterIndex = 1
      .AllowMultiSelect = False
      .InitialFileName = CurrentProject.path

      If .Show= -1 Then
         For Each vrtSelectedItem In .SelectedItems
            FileName = Trim(vrtSelectedItem)
         Next vrtSelectedItem
      Else
         Exit sub
      End If
   End With
   Set Fe = Nothing
   If FileName <> "" Then
      If Dir(Paths & "\photo\", vbDirectory) = "" Then MkDir Paths & "\photo\" '检测文件夹photo是否存在

      Me![照片路径].Visible = True
      Me![照片路径].SetFocus
      Me![照片路径].Text = FileName
      Dim fs
      Set fs = CreateObject("Scripting.FileSystemObject")
      fs.CopyFile FileName, CurrentProject.path & "\photo\" & Me.姓名 & ".jpg"

      Me.照片路径 = Paths & "\photo\" & Me.姓名 & ".jpg"
      Me![照片图像].Picture = Me![照片路径]
         '照片路径上显示复制后的照片路径
   End If

End Sub

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)