Finding a file

[Oldjay]

I have the follow macro

Sub RecallTemplatePartNumber(Optional pn As Long = -1)
Dim partbook As String
Dim partnumber As String
Dim r As Range


partnumber = InputBox("Please enter PART NUMBER file name to
recall", "OldTechnogologies LLC")

Quote = "\\SERVER3\Jobs\Estimate1\TEMPLATE1\PART NUMBER1\" & partnumber
& ".XLS"

If the file is not found I want to look in

Quote = "\\Server3\Database\prodscheduling\approvedparts\" & partnumber
& ".XLS

Workbooks.Open Filename:=Quote

 

[Bernie Deitrick]

Sub RecallTemplatePartNumber(Optional pn As Long = -1)
Dim partbook As String
Dim partnumber As String
Dim r As Range
partnumber = InputBox("Please enter PART NUMBER file name to recall",
"OldTechnogologies LLC")

'Use code here to make sure partnumber is valid

Quote = "\\SERVER3\Jobs\Estimate1\TEMPLATE1\PART NUMBER1\" & Partnumber
& ".XLS"
On Error GoTo DoesNotExist
Workbooks.Open Quote
Exit Sub
DoesNotExist:
Quote = "\\Server3\Database\prodscheduling\approvedparts\" & Partnumber
& ".XLS"
Workbooks.Open Quote
End Sub

Though you will need more error checking in case the second one doesn't
exist.

HTH,
Bernie
MS Excel MVP

 

[Rick Rothstein]

I don't have a way to check this macro here, but I think it should work...

Sub OpenPartNumberWorkbook()
Dim Quote As String
Dim PartNumber As String
Dim Servers As Variant
Servers = Array("\\SERVER3\Jobs\Estimate1\TEMPLATE1\PART NUMBER1\", _
"\\Server3\Database\prodscheduling\approvedparts\")
PartNumber = InputBox("Please enter PART NUMBER file name to recall" & _
"to recall", "OldTechnogologies LLC")
For X = LBound(Servers) To UBound(Servers)
Quote = Servers(X) & PartNumber & ".xls"
If Len(Quote) Then
Workbooks.Open Filename:=Quote
Exit Sub
End If
Next
MsgBox "File not found!"
End Sub

Note: If this works, then you can add as many server paths to the Array
function call as you want or need to.

 

[oldjay]

I didn't tell you everything. After I find and open the workbook I will be
copying information from the found file to the original open file.

Sub RecallTemplatePartNumber(Optional pn As Long = -1)
Dim partbook As String
Dim partnumber As String
Dim r As Range

Application.ScreenUpdating = False
Application.DisplayAlerts = False

If pn = -1 Then
partnumber = InputBox("Please enter PART NUMBER file name to
recall", "Auld Technogologies LLC")
Else
partnumber = pn
End If

Quote = "\\SERVER3\Jobs\Estimate1\TEMPLATE1\PART NUMBER1\" & partnumber
& ".XLS"
On Error GoTo DoesNotExist
Workbooks.Open Quote

DoesNotExist:
Quote = "\\Server3\Database\prodscheduling\approvedparts\" & partnumber &
".XLS"
Workbooks.Open Quote

Range("C4:C33").Select
Selection.Copy
Windows(MasterSheet).Activate
Sheets("MAIN").Select
Range("C4").Select
Selection.PasteSpecial Paste:=xlFormulas

 

[oldjay]

The code does not work if the part number is in the PART NUMBER1 folder. It
still goes to the DoesNotExist:and produces an error because the file is not
at this location
It needs some code to jump over the DoesNotExist code and go directly to the
Range("C4:C33").Select line if it finds the workbook in the PART NUMBER1
folder

 

[Bernie Deitrick]

You need to skip the second Quote/Open block if the first succeeds:

Quote = "\\SERVER3\Jobs\Estimate1\TEMPLATE1\PART NUMBER1\" & partnumber & ".XLS"
On Error GoTo DoesNotExist
Workbooks.Open Quote

'Success, so skip to getting data
Goto GetData:

DoesNotExist:
Quote = "C:\Delete These\Book2.xls" '"\\Server3\Database\prodscheduling\approvedparts\" & partnumber
& ".XLS"
Workbooks.Open Quote

GetData:
Range("C4:C33").Select
Selection.Copy
Windows(MasterSheet).Activate
Sheets("MAIN").Select
Range("C4").Select
Selection.PasteSpecial Paste:=xlFormulas

HTH,
Bernie
MS Excel MVP

 

[oldjay]

Thanks That did the trick

You need to skip the second Quote/Open block if the first succeeds:

Quote = "\\SERVER3\Jobs\Estimate1\TEMPLATE1\PART NUMBER1\" & partnumber & ".XLS"
On Error GoTo DoesNotExist
Workbooks.Open Quote

'Success, so skip to getting data
Goto GetData:

DoesNotExist:
Quote = "C:\Delete These\Book2.xls" '"\\Server3\Database\prodscheduling\approvedparts\" & partnumber
& ".XLS"
Workbooks.Open Quote

GetData:
Range("C4:C33").Select
Selection.Copy
Windows(MasterSheet).Activate
Sheets("MAIN").Select
Range("C4").Select
Selection.PasteSpecial Paste:=xlFormulas

HTH,
Bernie
MS Excel MVP