我想知道是否有人可以帮助我。
我使用下面的代码动态创建给定文件夹中的文件列表。
在列E中,列表的每一行都有一个链接'点击此处打开'允许用户打开每个文件。
但我现在希望改变这一点,而不是打开文件,链接将打开“保存”字样。对话框允许用户将文件发送到用户选择的文件夹,我必须承认这个问题让我困惑了一个多星期了。
Public Sub ListFilesInFolder(SourceFolder As Scripting.folder, IncludeSubfolders As Boolean)
Dim LastRow As Long
On Error Resume Next
For Each FileItem In SourceFolder.Files
' display file properties
Cells(iRow, 3).Formula = iRow - 12
Cells(iRow, 4).Formula = FileItem.Name
Cells(iRow, 5).Select
Selection.Hyperlinks.Add Anchor:=Selection, Address:= _
FileItem.Path, TextToDisplay:="Click Here to Open"
iRow = iRow + 1 ' next row number
With ActiveSheet
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End With
For Each Cell In Range("C13:E" & LastRow) ''change range accordingly
If Cell.Row Mod 2 = 1 Then ''highlights row 2,4,6 etc|= 0 highlights 1,3,5
Cell.Interior.Color = RGB(232, 232, 232) ''color to preference
Else
Cell.Interior.Color = RGB(141, 180, 226) 'color to preference or remove
End If
Next Cell
Next FileItem
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder, True
Next SubFolder
End If
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
End Sub
我尝试过使用命令' Application.Dialogs(xlDialogSaveAs)。显示'在代码的每一行中,我都无法使其工作,因为它只是要求用户在创建列表时保存文件。
我只是想知道是否有人可以看到这个,让我知道我哪里出错了。
非常感谢和亲切的问候
克里斯
答案 0 :(得分:0)
以下是将文件从给定地点复制到用户选择的目标文件夹的相关代码。我将它包装在FollowHyperlink
的工作表事件中,因为它听起来像是基于点击而执行此操作。
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim FSO
Dim sFile As String
Dim sDFolder As String
'path to file to copy, you will want to point this at a cell range
'this assume a single cell is selected
sFile = Target.Range.Value
'destination folder
Dim fldr As FileDialog
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
fldr.AllowMultiSelect = False
fldr.Show
'add the end slash for the copy operation
sDFolder = fldr.SelectedItems(1) & "\"
'FSO object to copy the file... True below overwrites if needed
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.CopyFile (sFile), sDFolder, True
End Sub