【access源码示例】上传图片或附件到指定文件夹或共享文件夹的通用函数
时 间:2012-06-01 11:59:41
作 者:金宇 ID:43 城市:江阴
摘 要:上传图片或附件到指定文件夹或共享文件夹的通用函数
正 文:
做了个通用的函数来处理上传图片或附件,主要使用了vba的FileSystemObject对象,其实就是将选中的图片或者附件复制到指定的文件夹,复制成功后函数会返回上传路径
'常量枚举图片和附件
Public Enum acFileType
acPicture = 1
acFiles = 2
End Enum
'======================================================
'函数名称: UploadFile
'功能描述: 复制图片或者附件到某个指定文件夹或者共享文件夹中
'输入参数: strDestinationPath 必需的,共享或者存放附件的目标文件夹路径。
' FileType 必需的,附件类型分图片和文件acPicture,acFiles
' bIsUpload 非必需的默认为True,True复制,False不复制
'返回参数: 字符串源文件路径或者目标文件路径
'使用示例: UploadFile("\\192.168.1.10\共享文件夹\",acPicture,True) '复制到共享文件夹,共享文件夹需要有写入权限
' UploadFile("C:\软件图片\",acPicture,True) 指定本地文件夹
'作 者: 金宇
'创建日期: 2012-05-30
'======================================================
Public Function UploadFile(strDestinationPath As String, _
FileType As acFileType, _
Optional bIsUpload As Boolean = True) As String
On Error GoTo ErrorHandler
Dim strSourceFile As String
Dim strDestinationFile As String
Dim strFullFileName As String
Dim FSO As Object
'如果文件夹路径右侧不带\,那就加上斜杠
If Right$(strDestinationPath, 1) <> "\" Then
strDestinationPath = strDestinationPath & "\"
End If
'检测是否存在文件夹
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.FolderExists(strDestinationPath) Then
MsgBox "此路径文件夹[" & strDestinationPath & "]未找到,请检查文件夹路径!", vbCritical, "系统提示"
Set FSO = Nothing
Exit Function
End If
With Application.FileDialog(3)
.Title = "Choose File"
.InitialFileName = ""
.Filters.Clear
Select Case FileType
Case 1
.Filters.Add "Graphics Files", "*.jpg;*.bmp;*.gif;*.png"
Case 2
.Filters.Add "Files", "*.pdf;*.doc;*.docx;*.xls;*.rar"
Case Else
.Filters.Add "All Files", "*.*"
End Select
.AllowMultiSelect = False
If .Show Then
strSourceFile = .SelectedItems.Item(1)
strDestinationFile = strDestinationPath & Mid$(strSourceFile, InStrRev(strSourceFile, "\") + 1)
strFullFileName = Mid$(strSourceFile, InStrRev(strSourceFile, "\") + 1)
If bIsUpload = True Then 'true则将选中的图片上传到指定的文件夹中,否则不上传只显示选择的图片
If FSO.FileExists(strDestinationFile) = True Then
If MsgBox("存在重复的文件名,是否替换?", vbOKCancel + vbInformation, "确认") = vbOK Then
FSO.copyfile strSourceFile, strDestinationFile, True
Else
Exit Function
End If
Else
FSO.copyfile strSourceFile, strDestinationFile
End If
Set FSO = Nothing
UploadFile = strDestinationFile
Else
UploadFile = strSourceFile
End If
End If
End With
ExitHere:
Set FSO = Nothing
Exit Function
ErrorHandler:
MsgBox Err.Description, vbInformation, "提示"
Resume ExitHere
End Function
附 件:
图 示:
Access软件网官方交流QQ群 (群号:54525238) Access源码网店
常见问答:
技术分类:
源码示例
- 【源码QQ群号19834647...(12.17)
- 【Access选项卡示例】Ac...(09.09)
- 【Access源码示例】按输入...(09.02)
- 【Access日期区间段查询】...(08.29)
- 【Access日期区间段查询】...(08.27)
- Access怎样才能实现日期时...(08.21)
- 【Access定时打开查询】A...(08.19)
- Access生成固定数量的记录...(08.13)
- Access怎样才能实现日期时...(08.12)
- Access利用导航窗体控件对...(08.03)
学习心得
最新文章
- Access表中的字段名、字段标题...(09.19)
- Access快速开发平台--更改“...(09.18)
- 【中秋及国庆优惠】Access培训...(09.15)
- Access如何将日期型的数值转换...(09.14)
- 英文输入法输入数据中存在单引号引起...(09.11)
- 【Access选项卡示例】Acce...(09.09)
- 让Access光标停留在指定的控件...(09.07)
- 关于Access查询条件里使用通配...(09.06)
- Access报表偷懒制作法--Ac...(09.05)
- Access快速开发平台--窗体数...(09.04)