根据文本框显示的路径下载相应的文件并自动打开

时　间:2016-11-17 09:56:38
作　者:KevinFan   ID：47553  城市：东莞
摘　要:不想直接打开共享内附件，避免用户修改原始的附件资料，根据文本框显示的附件路径下载（复制）相应的文件，调用另存为对话框让用户选择保存位置，文件保存后自动打开
正　文:

      前几天有个网友做了一个管理系统，他希望下载指定路径的附件，然后自动打开（不想直接打开共享内附件，避免用户修改原始的附件资料），在微信群里问了几天，提示他参考FileDialog，但是他想要现成的并发帖http://accessoft.com/bbs/showtopic.asp?id=26915，刚好自己有空也就研究了一下：

他说的下载，其实是复制（将共享文件复制到用户电脑），查询了和参考了大神们的资料，自己整合了一下，实现了功能。

1、参考大神的获取完整文件名代码：

Public Function GetFullFileName(strFileName As Variant) As String
    '返回完整文件名
    '例:"C:\File.txt" ,输出:"File.txt"
    Dim I As Integer
    For I = Len(strFileName) To 1 Step -1
        If Mid$(strFileName, I, 1) = "\" Then
            GetFullFileName = Mid$(strFileName, I + 1)
            Exit Function
        End If
    Next I
    GetFullFileName = strFileName
End Function

2、参考大神的复制文件代码：

Public Sub CopyFileWindowsWay(SourceFile As String, DestinationFile As String)
    Dim lngReturn As Long
    Dim typFileOperation As SHFILEOPSTRUCT
    With typFileOperation
        .hWnd = 0
        .wFunc = FO_COPY
        .pFrom = SourceFile & vbNullChar & vbNullChar    '源文件。
        .pTo = DestinationFile & vbNullChar & vbNullChar    '目标文件。
        .fFlags = FOF_ALLOWUNDO
    End With
    '拷贝操作。
    lngReturn = SHFileOperation(typFileOperation)
    If lngReturn <> 0 Then    '如果拷贝失败。
        MsgBox Err.LastDllError, vbCritical or vbOKOnly
    Else
        'MsgBox "复制成功！", vbInformation
        If typFileOperation.fAnyOperationsAborted = True Then
            MsgBox "Operation Failed", vbCritical or vbOKOnly
        End If
    End If
End Sub

3、下载按钮代码：
Private Sub Command4_Click()
    Dim strFileName As String
    Dim strPathName As String
    Dim strFilePath As String
    strFileName = GetFullFileName(Me.FilePath)
    With Application.FileDialog(2)  'msoFileDialogSaveAs
        '将下面一行的单引号去除,表示启用指定的文件夹位置
        '.InitialFileName = "D:\"
        .InitialFileName = strFileName
        If .Show Then
            strPathName = .SelectedItems(1)
            strFilePath = GetFilePath(strPathName)
            '如果文件已存在，则先删除已存在的文件，以达到替换目的
            If Dir(strPathName) <> "" Then Kill strPathName
            Call CopyFileWindowsWay(Me.FilePath, strFilePath)
        End If
    End With
    If strPathName <> "" Then
        Shell "explorer.exe """ & strPathName & """", vbNormalFocus
    End If
End Sub

附   件:

点击下载此附件

演   示:

Access软件网QQ交流群 (群号:54525238) 　　　　　　Access源码网店