Problem with hyperlink macro

D

Denis

Hello,
I have the following macro which works fine except when it cannot find a
file that match the search string.

When it does not find what it is looking for it goes to cell A1 in the
starting workbook where the macro button is and dumps the list of file
names it found in the directory searched... and overwrites whatever is
there. The user starts by selecting a cell in column G and press the
Hyperlink With Job Search button. It asks for a string to search and
creates a link to the appropriate file in the folder.

I would like the macro to say it did not find the file and to try again.

I'd appreciate any help with this.

Denis
-----------------------------------------------------------------------


Sub FastHyperlink()
Call List_DirectoryFast

End Sub

Sub List_DirectoryFast()

Dim stMyPATH As String
Dim stFILE As String
Dim I As Long
Dim MyRANGE As Range
Dim F As Variant
Dim C As Object


Application.ScreenUpdating = False

On Error GoTo OpenWorkBook:
Dim BookName As String
BookName = "FileList.xlsx"
Workbooks(BookName).Activate



OpenWorkBook:
If Err.Number = 9 Then
Workbooks.Open FileName:="\\Fsnt07\poly_od\UnApproved\_Quality\Raw
Materials\MasterBatch\Accepted C of A's\FileList.xlsx"
Resume
End If


ActiveWindow.SmallScroll Down:=-21
Range("A1").Select

Cells(1, "A").EntireColumn.Clear
stMyPATH = "\\Fsnt07\poly_od\UnApproved\_Quality\Raw Materials
\MasterBatch\Accepted C of A's"
'---- LOOK FOR FILES and DIRECTORIES ----
stFILE = Dir(stMyPATH & "\*.*", vbDirectory)
I = 1
Do Until stFILE = ""
If ((stFILE <> ".") And (stFILE <> "..")) Then
Cells(I, "A") = stFILE
I = I + 1
End If
stFILE = Dir()
Loop


Range("A:A").ColumnWidth = 30


Application.Workbooks("FileList.xlsx").Activate

'find wildcard character * in text
Dim cell As Range, FirstAddress As String, FoundList As String
With ActiveSheet.UsedRange
Dim sFind As String

sFind = Application.InputBox("Enter the search string")
'use tilde to find an *
Set cell = .Find(sFind, LookIn:=xlValues, SearchOrder:=xlByRows,
_
LookAt:=xlPart)
If Not cell Is Nothing Then
FirstAddress = cell.Address '< Bookmark start point
Do
FoundList = FoundList & "Cell " & cell.Address(0, 0) & _
" =" & vbTab & cell & vbNewLine
Set cell = .FindNext(cell)
Loop Until cell Is Nothing Or cell.Address = FirstAddress
End If
End With

Application.Workbooks("Masterbatch Log Sheet.xls").Activate

Application.ScreenUpdating = True

ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=("\\Fsnt07
\poly_od\UnApproved\_Quality\Raw Materials\MasterBatch\Accepted C of A's
\") & cell
TextToDisplay = "C o A"

Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Set cell = Nothing

Application.Workbooks("FileList.xlsx").Activate
ActiveWorkbook.Close False

MsgBox "Hyperlink has been created"

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top