Code to Skip the File Extension While hyperlink the Files

Question

The results include the file extension also which I don't want displayed. How do I drop the file extension from the text?

Sub mymacro()
Dim objcreate As Object, objFolder As Object, objFile As Object, i As Integer
Dim ws As Worksheet, rng As Range

Set ws = Sheets("Sheet1")
Set rng = ws.Range("C1")


Set objcreate = createobject("Scripting.FileSystemObject")

Set objFolder = objcreate.GetFolder(rng)
i = 0

For Each objFile In objFolder.Files
'select cell
Range(Cells(i + 1, 1), Cells(i + 1, 1)).Select
'create hyperlink in selected cell
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
objFile.Path, _
TextToDisplay:=objFile.Name
i = i + 1
Next objFile
End Sub

score 0 · Accepted Answer · answered Dec 06 '16 at 12:31

0

Just use the LEFT function to cut off the last four characters TextToDisplay:=LEFT(objFile.Name, LEN(objFile.Name) - 4)

answered Dec 06 '16 at 12:31

mrbubble456

112
4

it wont work if the extension's length is not 3. Your code will fail if the extension is of length 2, or 4 or anything else than 3. In this particular scenario, if the extension is of length 3, it would work. – Kumar Sourav Dec 06 '16 at 12:48

score 0 · Answer 2 · edited May 23 '17 at 10:30

You can do it in many ways. Something like this has already been answered earlier : https://stackoverflow.com/a/27924854/6151782

I will try to handle it in different way, using split. Have a look at code below:

Sub mymacro()
Dim objcreate As Object, objFolder As Object, objFile As Object, i As Integer
Dim ws As Worksheet, rng As Range

Set ws = Sheets("Sheet1")
Set rng = ws.Range("C1")


Set objcreate = createobject("Scripting.FileSystemObject")

Set objFolder = objcreate.GetFolder(rng)
i = 0

For Each objFile In objFolder.Files
'select cell
Range(Cells(i + 1, 1), Cells(i + 1, 1)).Select
'create hyperlink in selected cell
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
objFile.Path, _
TextToDisplay:=objFile.Name
tmpArr = Split(TextToDisplay,".")

Dim finalTextToDisplay
tmpArr = split(TextToDisplay,".")
finalTextToDisplay = ""

'considering there might be a dot in the file name itself, we will take the string till the last dot using loop
    loopLimit = UBound(tmpArr)
    for j=0 to loopLimit-1 
    if i = 0 then
            finalTextToDisplay = tmpArr(j)
    else
        finalTextToDisplay =tmpArr(j) & "." & finalTextToDisplay
    end if

    Next
i = i + 1
Next objFile
End Sub

In above code I looped till i encounter the last dot. And to avoid a already trailing dot, I had to put an if condition so that it would not append a dot with a blank finalTextToDisplay (for the first iteration it would be empty). You can also start the loop from 1 and set the value in finalTextToDisplay before loop to avoid the if condition.

Code to Skip the File Extension While hyperlink the Files

2 Answers2