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
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