【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群 (群号:483923997) Access源码网店
常见问答:
技术分类:
源码示例
- 【源码QQ群号19834647...(12.17)
- 【Access更新查询】更新查...(05.15)
- 【Access小作品】简单的待...(04.30)
- 【Access窗体导出PDF】...(04.08)
- 【Access窗体导出PDF】...(04.07)
- Access两种方式实现即时更...(03.01)
- Access隐藏与显示lacc...(01.12)
- 【Access高效办公】将每个...(12.23)
- Access21点游戏源代码(12.13)
- 【Access窗体导出Exce...(11.15)
学习心得
最新文章
- 【Access更新查询】通过更新查...(05.20)
- 精美简单实用的系统面板_完善版(改...(05.18)
- Access提示方法成员未找到的解...(05.17)
- Access运行时错误-21472...(05.15)
- 【Access更新查询】更新查询如...(05.15)
- 日期不为空怎么写表达式?[字段名]...(05.14)
- 附件字段如何判断myPictrue...(05.13)
- Access链接表SQL SERV...(05.11)
- Access快速开发平台企业版--...(05.09)
- 新版铁路工程管理系统V2.0(05.08)