Can anyone help. I have the following code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 7 Then
MakeHyperLink Target, "Q:\"
End If
End Sub
Option Explicit
Private Files As Dictionary
Private StrFile As String
Dim StrFlePath As String, FleCollection, fle, f1, fs, f2, subfld
Sub MakeHyperLink(InRange As Range, _
ToFolder As String, _
Optional InSheet As Worksheet, _
Optional WithExt As String = "doc")
Dim rng As Range
Dim Filename As String
Dim Ext As String
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
If Files Is Nothing Then
GetFileAddress
End If
'check to see if folder has trailing \
If Right(ToFolder, 1) <> "\" Then
Filename = ToFolder & "\"
Else
Filename = ToFolder
End If
'check to see if need ext
If WithExt <> "" Then
'check to see if ext has leading dot
If Left(WithExt, 1) <> "." Then
WithExt = "." & WithExt
End If
End If
'if not explicit sheet then assign active
If InSheet Is Nothing Then
Set InSheet = ActiveSheet
End If
'now for every cell in range
For Each rng In InRange
'does range have value
If rng <> "" Then
'make hyperlink to file
StrFlePath = Files(UCase(rng.Text & WithExt))
InSheet.Hyperlinks.Add Anchor:=rng, Address:= _
StrFlePath, TextToDisplay:=rng.Text
End If
Next
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End Sub
Sub GetFileAddress()
Set Files = New Dictionary
FindFolder "Q:\"
End Sub
Sub FindFolder(strPath As String)
Set fs = CreateObject("scripting.filesystemobject")
Set f1 = fs.GetFolder(strPath)
Set f2 = f1.SubFolders
Set FleCollection = f1.Files
For Each fle In FleCollection
If Not (Files.Exists(UCase(fle.Name))) Then
Files.Add UCase(fle.Name), fle.Path
End If
Next
For Each subfld In f2
FindFolder subfld.Path
Next
End Sub
This works perfectly except for one thing, when you first open the workbook and type the file name in the G column (7), it takes about 15 minutes for the code to run and find the file name. After that you can type the file name and it only takes a second. Once you close the workbook and open it back up then you have to wait at least another 15 minutes after you type the first filename again. Is there a way for it not to take so long to when in type the filename in the first time.