Macro code is not working in Excel 2013 (I think due to appliation.filesearch errors) Help most appreciated

B

bri47j10

New Member
Joined
Apr 23, 2015
Messages
2
My old boss has retired and I had a document cotrol sheet that opened files (any format including PDF's) from folders with the same name as the tab. since i have now been forced to use excel 2013 it does not work. Please can someone help me!!! The code is below: (I think it is somthing to do with appliation.filesearch!!!

Public myFile, mylist()
Sub Open_File()
'
' Macro1 Macro
' Macro recorded 05/11/2010 by bc
'
Dim myStart As Integer, myLength As Integer, myTab
myFile = Cells(ActiveCell.Row, 1).Value
myTab = "\" & ActiveSheet.Name
myLength = 0
myStart = Len(myFile) - 3
If InStr(myStart, myFile, ".", vbBinaryCompare) = 0 Then
myStart = Len(Cells(ActiveCell.Row, 1).Value)
Else
myStart = myStart - 1
End If
For i = 1 To 5
myLength = InStr(myLength + 1, myFile, "-", vbBinaryCompare)
Next i
myLength = myLength + 7 'length of File name containing a string of type ??-???-??-???-???-???????
With Application.FileSearch
ReSearchLine:
.NewSearch
.LookIn = ActiveWorkbook.Path & myTab
.Filename = "*" & Left(myFile, myLength) & "*.*"
.Execute
If .FoundFiles.Count = 0 Then
myTab = MsgBox("File " & myFile & " has not been saved in the '" & myTab & "' sub-folder." & Chr(13) & Chr(13) & _
"Do you want to search in another sub-folder?", vbYesNo)
If myTab = vbNo Then
Exit Sub
Else
myTab = "\" & InputBox("Insert the sub-folder name.")
GoTo ReSearchLine
End If
End If
If .FoundFiles.Count = 1 Then
myFile = .FoundFiles(1)
ElseIf myStart > myLength Then
myLength = myStart
GoTo ReSearchLine
Else
ReDim mylist(.FoundFiles.Count)
mylist(0) = .FoundFiles.Count
For i = 1 To .FoundFiles.Count
mylist(i) = Right(.FoundFiles(i), Len(.FoundFiles(i)) - Len(ActiveWorkbook.Path) - 1)
'MsgBox (myList(0) & " simailar files found." & Chr(10) & i & ". - " & myList(i))
Next i
UserForm1.Show
If myFile = "None Selected" Then
MsgBox "No File for opening was selected - Macro Ending."
Exit Sub
ElseIf myFile = "Exit" Then
MsgBox "Macro Terminated."
Exit Sub
End If
myFile = ActiveWorkbook.Path & "\" & myFile
End If
End With
ActiveWorkbook.FollowHyperlink Address:=myFile, NewWindow:=True
'ActiveWorkbook.FollowHyperlink Address:=myFile, NewWindow:=True
End Sub
Sub Open_Active_Cell_File()
'
' Macro1 Macro
' Macro recorded 05/11/2010 by bc
'
Dim myStart As Integer, myLength As Integer, myTab
myFile = ActiveCell.Value
myTab = "\" & ActiveSheet.Name
myLength = 0
myStart = Len(myFile) - 3
If InStr(myStart, myFile, ".", vbBinaryCompare) = 0 Then
myStart = Len(Cells(ActiveCell.Row, 1).Value)
Else
myStart = myStart - 1
End If
For i = 1 To 5
myLength = InStr(myLength + 1, myFile, "-", vbBinaryCompare)
Next i
myLength = myLength + 7 'length of File name containing a string of type ??-???-??-???-???-???????
With Application.FileSearch
ReSearchLine:
.NewSearch
.LookIn = ActiveWorkbook.Path & myTab
.Filename = "*" & Left(myFile, myLength) & "*.*"
.Execute
If .FoundFiles.Count = 0 Then
myTab = MsgBox("File " & myFile & " has not been saved in the '" & myTab & "' sub-folder." & Chr(13) & Chr(13) & _
"Do you want to search in another sub-folder?", vbYesNo)
If myTab = vbNo Then
Exit Sub
Else
myTab = "\" & InputBox("Insert the sub-folder name.")
GoTo ReSearchLine
End If
End If
If .FoundFiles.Count = 1 Then
myFile = .FoundFiles(1)
ElseIf myStart > myLength Then
myLength = myStart
GoTo ReSearchLine
Else
ReDim mylist(.FoundFiles.Count)
mylist(0) = .FoundFiles.Count
For i = 1 To .FoundFiles.Count
mylist(i) = Right(.FoundFiles(i), Len(.FoundFiles(i)) - Len(ActiveWorkbook.Path) - 1)
'MsgBox (myList(0) & " simailar files found." & Chr(10) & i & ". - " & myList(i))
Next i
UserForm1.Show
If myFile = "None Selected" Then
MsgBox "No File for opening was selected - Macro Ending."
Exit Sub
ElseIf myFile = "Exit" Then
MsgBox "Macro Terminated."
Exit Sub
End If
myFile = ActiveWorkbook.Path & "\" & myFile
End If
End With
ActiveWorkbook.FollowHyperlink Address:=myFile, NewWindow:=True
'ActiveWorkbook.FollowHyperlink Address:=myFile, NewWindow:=True
End Sub
Sub Open_Lifting_Plan()
Dim myStart As Integer, myLength As Integer, myTab
myFile = Cells(ActiveCell.Row, 1).Value
myTab = "\" & Cells(ActiveCell.Row, 2).Value
'myLength = 0
'myStart = Len(myFile) - 3
'If InStr(myStart, myFile, ".", vbBinaryCompare) = 0 Then
'myStart = Len(Cells(ActiveCell.Row, 1).Value)
'Else
'myStart = myStart - 1
'End If
'For i = 1 To 5
'myLength = InStr(myLength + 1, myFile, "-", vbBinaryCompare)
'Next i
'myLength = myLength + 7 'length of File name containing a string of type ??-???-??-???-???-???????
With Application.FileSearch
ReSearchLine:
.NewSearch
.LookIn = "K:\LondonDLR3rdCar" & myTab
.Filename = myFile
.Execute
If .FoundFiles.Count = 0 Then
myTab = MsgBox("File:- '" & myFile & "' has not been found in the '" & myTab & "' sub-folder.", vbOKOnly)
'If myTab = vbNo Then
Exit Sub
'Else
'myTab = "\" & InputBox("Insert the sub-folder name.")
'GoTo ReSearchLine
'End If
End If
'If .FoundFiles.Count = 1 Then
' myFile = .FoundFiles(1)
'ElseIf myStart > myLength Then
'myLength = myStart
'GoTo ReSearchLine
'Else
' ReDim mylist(.FoundFiles.Count)
' mylist(0) = .FoundFiles.Count
' For i = 1 To .FoundFiles.Count
'mylist(i) = Right(.FoundFiles(i), Len(.FoundFiles(i)) - Len(ActiveWorkbook.Path) - 1)
'MsgBox (myList(0) & " simailar files found." & Chr(10) & i & ". - " & myList(i))
'Next i
'UserForm1.Show
'If myFile = "None Selected" Then
' MsgBox "No File for opening was selected - Macro Ending."
' Exit Sub
'ElseIf myFile = "Exit" Then
' MsgBox "Macro Terminated."
' Exit Sub
'End If
myFile = "K:\LondonDLR3rdCar" & myTab & "\" & myFile
'End If
End With
ActiveWorkbook.FollowHyperlink Address:=myFile, NewWindow:=True
'ActiveWorkbook.FollowHyperlink Address:=myFile, NewWindow:=True
End Sub
 

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
Sort by date Sort by votes
You must log in or register to reply here.

Similar threads

J
  • Solved
Excel VBA to add file name to column C in worksheet
Replies
1
Views
617
mumps
mumps
A
  • Question Question
VBA run-time error
Replies
2
Views
450
Aaro23
A
D
  • Solved
Copying file path from a cell?
Replies
2
Views
386
Dave_george
D
I
  • Question Question
Advice for slight alteration to existing working code
Replies
1
Views
192
ipbr21054
I
K
  • Question Question
Issues copy/move files
Replies
1
Views
512
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,223,214
Messages
6,170,774
Members
452,353
Latest member
strainu

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top