PDA

View Full Version : [SOLVED] VBA FollowHyperlink



hobbiton73
04-12-2015, 11:50 PM
Hi, I wonder whether someone can help me please.

I'm using the code below to create a hyperlink against filenames which have been retrieved from a given folder.


Public Sub ListFilesInFolderXtn(SourceFolder As Scripting.folder, IncludeSubfolders As Boolean)




On Error Resume Next
Dim FileArray As Variant


FileArray = Get_File_Type_Array


For Each FileItem In SourceFolder.Files


Call ReturnFileType(FileItem.Type, FileArray)


If IsFileTypeExists = True Then


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


End If


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
' fName = Application.GetSaveAsFilename(InitialFileName:=FileItem.Name)
'ActiveWorkbook.SaveAs Filename:=fName
Next FileItem


If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolderXtn SubFolder, True
Next SubFolder
End If


Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
End Sub


I then have another script which runs on a 'FollowHyperlink' event. Could someone tell me please, how I can link the two, so that when I click the hyperlink, this fires the 'FollowHyperlink' script.

Many thanks and kind regards

Chris

mancubus
04-13-2015, 02:19 AM
hi.

Like?


Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)

'other code here
Call AnotherScritp
'other code here
Call ListFilesInFolderXtn("C:\Test", True)
'other code here

End Sub

hobbiton73
04-13-2015, 05:22 AM
Hi @mancubus, thank you very much for your help with this.

I've used the code you kindly provided but I can't get this to work.

I've incorporated the two scripts as shown below, (I have to admit I received help with 'FollowHyperlink' script):


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
Call ListFilesInFolderstn("Z:\CHRIS\Work", True)
End Sub

But when I run this I receive the following error 'Compile error type mismatch' and the line which debug points to is
"Z:\CHRIS\Work" but I know that the path is correct. In addtion the file from the hyperlink still opens.

Many thanks and kind regards

Chris

mancubus
04-14-2015, 02:41 AM
welcome.

in ListFilesInFolderXtn sub you did not declare iRow. so it is 0. at first increment Cells(iRow, 3) is Cells(0, 3). this is nothing. correct this first. add iRow = 1 before the loop, for ex.

i need to know what Get_File_Type_Arrayand IsFileTypeExists functions do, though i have a guess...

if you can post your workbook here we may proceed without having to guess.

hobbiton73
04-14-2015, 09:54 AM
Hi @mancubus, thank you for coming back to me with this.

Following your kind suggestion I've left the iRow value intact. It is correct and hopefully you'll be able to see this in the sub routine 'btnFetchFiles'. The 'btnFetchFiles is is the script which in turn calls the 'ListFilesInFolderXtn' which I highlighted above.

I'll now explain how the macro works. There are two ways to fetch the files, the first is to click the button 'Fetch All File Details', the second, is to select the type of file via the check boxes (This is where the 'Get_File_Type_Array' comes into affect) then click the same button.

I have to admit this script isn't entirely mine, I use the tutorial here: http://www.learnexcelmacro.com/wp/2012/08/download-free-file-manager-new-version/ so this may also help.

Anyway, as requested I've attached a file for you to look at. Please note you will need to change the file to retrieve files from your own drives.

Many thanks and kind regards

Chris

mancubus
04-14-2015, 02:34 PM
you are welcome.

at first glance i noticed Worksheet_FollowHyperlink evet code is in a standard module.
cut and paste it to related worksheet's (File Manager) code module.

hobbiton73
04-14-2015, 11:28 PM
Hi @mancucus, it's nice to hear from you again.

I've moved the code into the 'file Manager' code module and unfortunately the links are still trying to open the file rather than allowing the user to save it. I just wonder whether the 'Follow Hyperlink' script is correct?

I'm sorry for causing all these problems!

Many thanks and kind regards

Chris

mancubus
04-15-2015, 01:10 AM
hi.

these downloadable "file manager" workbooks are more or less the same. thanks to all contributors.

my aproach in the forum is to answer the questions first, if i can. :)

as the name implies, FollowHyperlink follows the link clicked and opens/loads the document in its application.

if you want to copy a listed file to another folder, i recommend you use another worksheet event. imo, SelectionChange serves this purpose. you will need an extra column which houses file paths.

please let me know if you need any help for this.

hobbiton73
04-15-2015, 01:31 AM
Hi @mancubius, thank you for coming back to me sao quickly. I'm afraid my limited VB knowledge ran out some time ago, so if you were able to provide some further help that would be very much appreciated.

Many thanks and kindest regards

Chris

mancubus
04-15-2015, 02:15 AM
copy E12 to F12
input "File Full Name" in E12
modify the ListFilesInFolder and ListFilesInFolderXtn procedures as below:


Cells(iRow, 3).Formula = iRow - 12
Cells(iRow, 4).Formula = FileItem.Name
Cells(iRow, 5).Formula = FileItem.Path
Cells(iRow, 6).Hyperlinks.Add Anchor:=Cells(iRow, 6), Address:= _
FileItem.Path, TextToDisplay:="Click Here to Open"


paste below to worksheet's code modüle (delete previous FollowHyperlink):



Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim sFile As String
Dim sDFolder As String

With Target
If .Value = "" Then Exit Sub
If .Count > 1 Then Exit Sub
If .Row < 13 Then Exit Sub
If .Row > .Parent.UsedRange.Rows.Count Then Exit Sub
If .Column <> 5 Then Exit Sub
sFile = .Value
End With
'path to file to copy, you will want to point this at a cell range
'this assume a single cell is selected destination folder

With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = -1 Then
sDFolder = .SelectedItems(1) & "\" 'add the end slash for the copy operation
Else
MsgBox "Cancelled!" & vbCr & _
"Please pick a folder to copy the selected file to!", vbOKOnly + vbCritical, "Program sonlandırılıyor..."
Exit Sub
End If
End With

With CreateObject("Scripting.FileSystemObject")
.CopyFile (sFile), sDFolder, True
End With

End Sub


you can insert a new button to worksheet and change SelectionChange event to button click event.

hobbiton73
04-15-2015, 03:33 AM
Hi @mancubus, thank very much for this, it's great. I am however having a slight problem in that when I click the 'Fetch All Files Details' button I receive a 'Type Mismatch' error and debug points to this line as the error
If .Value = "" Then
which is in the script you kindly provided.

But I cancel out this line the script runs, but unfortunately the file still opens when I click on the hyperlink.

Many thanks and kind regards

Chris

mancubus
04-15-2015, 03:53 AM
does your code contain any "select" statement? i removed the one i noticed as you can see.

try adding following lines:
Application.EnableEvents = False before With Target line
Application.EnableEvents = True before End Sub line

mancubus
04-15-2015, 03:55 AM
but unfortunately the file still opens when I click on the hyperlink.

this what a hyperlink is expected to do. :)
so do not click on it. or if you will not use them, do not insert them in Column F at all.

hobbiton73
04-15-2015, 05:04 AM
Hi, firstly the lines you suggested work great so thank you.

But now my apologies for being a little dense here. But could you explain how if I remove the hyperlinks, how can I select an individual file?

I also note you say that a hyperlink is supposed to open the file but as per post #7 I was hoping to click the hyperlink and then for the script to open a dialog which enabled the user to copy the file and paste it to a destination of their choice. Could you tell me please is this not possibe?

Many thanks and kind regards

Chris

mancubus
04-15-2015, 06:30 AM
Worksheet_SelectionChange event code does what you want.

in order Follow Hyperlink event to get triggered, a hyperlink must be clicked. and if a hyperlink is clicked, it opens the associated file.

you want to click "click here to open the file" link and you dont want the file open. :)

hobbiton73
04-15-2015, 10:37 PM
Ah I see @mancubus. Thank you for the explanation. It's a lot clearer now.

In that case I'm sorry to say the 'Worksheet Selection Change' event isn't working. I've tried the script in a standard module, in the 'File Manager' worksheet module and the 'This Workbook' module and in all occasiosn the links try to open the files. I note from the 'Selection change' script that there should be a message which pops up asking "Please pick a folder to copy the selected file to" but I'm not even receiving this message.

I'm sure this must be working at your end and I'm not sure whether you even have time to do this, but is there any chance please you could insert the code into the example I posted to you and send this back to me, so I can see where I've gone wrong and so I don't have to keep persatering you?

Many thanks and kind regards

Chris

mancubus
04-16-2015, 02:04 PM
attached is modified version.

Selection_Change event code must be in Worksheet's code module.

just copy it.

or if you like, you may use the file as is.

hobbiton73
04-16-2015, 11:08 PM
Hi @mancubus, thank you so very much for coming back to me with this.

I'm so very sorry though because this isn't working as expected. Let me explain:



When I select a file type via the checkbox, or select the check box 'Fetch All File Details' and click the button I'd like to retrieve the desired files from the folder hardcoded into the script.
Then when the list has been created select the hyperlink on the relevant row and for that click to take the user to the svae file dialog box to select the folder to copy this into.


But what is actually happening is:



When I selet the file type check boxes or 'Fetch All File Details' checkbox and click the button the script asks for the folder to open, then
When I click the hyperlink on the relevant row the file opens.


I'm really sorry to continue being a pain with this, I really wish I had a greater knowledge so I could help further because I know you've gone to an awful lot of trouble for which I apologise.

I just wondered whether you may be able to help please.

Kind Regards

Chris

mancubus
04-17-2015, 12:50 AM
this is my last post to the thread.

:banghead:

hobbiton73
04-17-2015, 12:56 AM
Fair enough @mancubus, I'm sorry if I've offended you in anyway. Thank you for all your help, time and trouble it is truly appreciated. Have a good day.

Kind regards

Chris

mancubus
04-17-2015, 04:57 AM
@hobbiton73

clicking a hyperlink will load the linked document. this as what hyperlinks are for. as i keep saying this, you're asking the oposite over and over again.

why do you insist on using Worksheet_FollowHyperlink event when other events exist?

for selecting a hyperlinked cell without loading its document you can do one of the following:
... click and hold Mouse (as the tip says).
... hover curser over desired cell and click on white space (cursor icon turns from "hand" to thick "white cross").
... while holding ctrl and shift keys click cell.

there may be other ways which i dont know.

by correctly doing any of the above you select a cell but not follow its hyperlink. so Worksheet_FollowHyperlink is not triggered.

use Worksheet_SelectionChange event which i proposed.

i would use the file i uploaded since it includes additional functions and corrections.

hobbiton73
04-17-2015, 05:36 AM
@mancubus, I fully appreciate what you're saying. I'm using the file you kindly provided and you'll know that when you select the 'Fetch All File Details" check box and click the button the user is presented with a dialog box, to open the folder to select the files from. But I'm not even able to see the files in the sub folder and as per my original file I'd like to automatically list all the files from the hard coded file path.

I completely understand your comment about the hyperlink, but unfortunately I'm not even able to get to the part which runs the 'Worksheet_SelectionChange' sub routine.

Many thanks and kind regards

Chris

mancubus
04-17-2015, 11:07 AM
you are welcome.

this the code:



Private Sub btnFetchFiles_Click()
Dim i As Long

Set fso = New Scripting.FileSystemObject
iRow = 13

With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "D:\Legacy Locker"
.AllowMultiSelect = False
If .Show = -1 Then
fPath = .SelectedItems(1) & "\"
Else
MsgBox "Cancelled!" & vbCr & _
"Please pick a folder to list files from!", vbOKOnly + vbCritical, "Ending program..."
Exit Sub
End If
End With


If CountFiles(fPath) > 0 Then
Call ClearResult(Range("C12").CurrentRegion.Offset(1))
If CheckBox1.Value = True Then
Call ListFilesInFolder(fso.GetFolder(fPath), True)
Else
Call ListFilesInFolderXtn(fso.GetFolder(fPath), True)
End If
lblFCount.Caption = iRow - 13

Call ColorCells
Else
MsgBox "Selected Folder Does Not Contain a File!" & vbNewLine & vbNewLine & "Select Correct One and Try Again!", vbInformation, "File Manager - http://www.LearnExcelMacro.Com"
End If

End Sub


initial file is D:\Legacy Locker.
just click ok. FolderPicker dialog provides felxibilty in case the folder name changes.

mancubus
04-17-2015, 11:18 AM
if you dont want dialog shop up replace aboce code with below code.



Private Sub btnFetchFiles_Click()
iRow = 13
fPath = "D:\Legacy Locker"
Set FSO = New Scripting.FileSystemObject

If FSO.FolderExists(fPath) <> False Then
Set SourceFolder = FSO.GetFolder(fPath)
IsSubFolder = True
If CountFiles(fPath) > 0 Then
Call ClearResult
If CheckBox1.Value = True Then
Call ListFilesInFolder(SourceFolder, IsSubFolder)
Else
Call ListFilesInFolderXtn(SourceFolder, IsSubFolder)
End If
lblFCount.Caption = iRow - 13
Call ColorCells
Else
MsgBox "Folder Path Can not be Empty !!" & vbNewLine & vbNewLine & "", vbInformation, "File Manager - http://www.LearnExcelMacro.Com"
End If
Else
MsgBox "Selected Path Does Not Exist !!" & vbNewLine & vbNewLine & "Select Correct One and Try Again !!", vbInformation, "File Manager - http://www.LearnExcelMacro.Com"
End If

End Sub

hobbiton73
04-18-2015, 07:38 AM
Hi @mancucbus, thank you for this, but unfortunately this doesn't work. When I click the button to fetch all files I receive an 'Argument is not optional' message with debug highlighting this line as the cause: `Call ClearResult` If I then cancel this and click the button again I receive the pop up message "Folder Path Can Not Be Empty!" even though it is not.

On another note you highlighted that it wasn't possible to use the hyperlink, so could you possibly tell me please once I retrieve a list of files how do I select the file to save?

Kind Regards

Chris

mancubus
04-18-2015, 01:51 PM
post the latest workbook pls...

hobbiton73
04-19-2015, 06:00 AM
Hi, please find attached the workbook you requested.

Kind Regards

Chris

Tom Jones
04-19-2015, 09:45 AM
Try file in attach
Small add to mancubus code.

hobbiton73
04-19-2015, 10:20 PM
Hi @ Tom Jones, thank you for taking the time to reply to my post, but unfortunately I'm still getting the same error messages as before.

Kind Regards

Chris

Tom Jones
04-19-2015, 11:11 PM
OK see this file.

hobbiton73
04-20-2015, 12:16 AM
Hi @Tom Jones, thank you very much for this, but unfortunately when I click the button I immediayely recieve the 'Folder Path Can not be Empty !!' error message. Kind Regards

hobbiton73
04-21-2015, 10:21 PM
Hi, further to this post I received help and a working solution here: http://stackoverflow.com/questions/29691787/vbs-save-file-from-link.

Kind regards

Chris