Search code examples
excelexcel-2013vba

VBS Save File From Link


I wonder whether someone can help me please.

I wanting to use this solution in a script I'm trying to put together, but I'm a little unsure about how to make a change which needs to be made.

You'll see in the solution that the file type which is opened is a Excel and indeed it's saved as such. But I the files I'd like to open and save are a mixture of .docx and .dat (Used by Dragon software) files.

Could someone possible tell me please is there a way by which I can amend the code so it opens and saves the files in file types other than Excel workbooks.

The reason behind this question because I'm currently using a script which creates a list of files in a Excel spreadsheet from a given folder. For each file that is retrieved there is a hyperlink, which I'd like to add fucntionality to which enables the user to copy the file and save it to a location of their choice.

To help this is the code which I use to create the list of files.

Public Sub ListFilesInFolder(SourceFolder As Scripting.folder, IncludeSubfolders As Boolean)
    Dim LastRow As Long
    Dim fName As String
    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).Formula = FileItem.Path
        Cells(iRow, 6).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:F" & 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

Many thanks and kind regards

Chris


Solution

  • Miguel provided a fantastic solution which on initial testing appeared to work 100%. But as you will see from the comments at the end of the post there were some issues when the user cancelled the operation, so I made another post at this link where the problems were ironed out. Many thanks and kind regards. Chris