VBA Сохранить файл как

Question

Интересно, может ли кто-нибудь помочь мне, пожалуйста.

Я использую приведенный ниже код для динамического создания списка файлов из данной папки.

В столбце 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) .Show» в каждой строке кода, но я не могу получить эту работу, потому что все это делает предложит пользователю сохранить файл как он создает список.

Я просто задавался вопросом, может ли кто-нибудь посмотреть на это, и сообщите мне, где я ошибся.

Большое спасибо и добрых пожелания

Chris

Answer 1

Вот соответствующий код для копирования файла из заданного места в папку назначения, выбранный пользователем. Я завернул его в событие Worksheet для 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