Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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\Ra w 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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Hyperlink problem | Excel Programming | |||
Hyperlink Problem | Excel Discussion (Misc queries) | |||
Intra-workbook hyperlink: macro/function to return to hyperlink ce | Excel Discussion (Misc queries) | |||
Macro to Copy Hyperlink to another file as a HYPERLINK, not text... | Excel Programming | |||
Hyperlink problem | Excel Programming |