设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 1656|回复: 1
打印 上一主题 下一主题

[Access本身] 图片添加 复制选择图片问题

[复制链接]
跳转到指定楼层
1#
发表于 2010-6-16 14:08:43 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
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代码
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖 订阅订阅
2#
发表于 2010-6-17 10:07:01 | 只看该作者
本帖最后由 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
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-26 03:31 , Processed in 0.074313 second(s), 25 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表