VBA - Überprüfung von zwei verschiedenen Pfaden Standorte

Question

Ich habe ein bestehendes VBA-Projekt, das ich einfach ändern muß, auch wenn nicht schreist neu geschrieben einen Tag werden.

Das Blatt hat ein verstecktes Blatt namens Optionen, die einen Dateipfad in B3 führt und dass Pfad \ Datei-Server aufgerufen wird \ Drafting \ MBS_JOBS \

Der Code dann eine Variable diesen Weg weist:

strpathtofile = Sheets("Options").Range("B3").Value 

Schließlich später, es setzt sie alle zusammen mit diesem:

strFileToOpen = strpathtofile & ActiveCell.Value & strFilename 

Was ich jetzt tun müssen, ist haben sie einen zweiten Pfad überprüfen. Also habe ich einen Teil des Codes dupliziert.

Ich habe den neuen Pfad in B7 von der Seite Optionen zuerst. Dann habe ich eine Variable und zugeordnet es:

Public strpathtoProj As String 
strpathtoProj = Sheets("Options").Range("B7").Value 

Also, was ich tun muß, ist dieses Programm auch diesen anderen Pfad überprüfen. Also frage mich, ob ich eine Art von IF benötigen, oder ELSE-Anweisung, um dieses Teil:

strFileToOpen = strpathtofile & ActiveCell.Value & strFilename 

Um es auch bei strpathtoProj aussehen.

Ich bin ein „work in progress“ VBA Entwickler als Typ SOLO IT für ein kleines Unternehmen und lerne, wie ich gehe.

Hier sind die Module, die strpathtofile verwenden (und man kann sehen, dass ich schon in dort einen Code für die strpathtoProj hätte, dass ich jetzt verwenden müssen):

Sub RUN_SUMMARY_REPORT() 

'assign variable... this is here just in case they haven't ran the "TEST" button 
strpathtofile = Sheets("Options").Range("B3").Value 
strFilename = Sheets("Options").Range("B4").Value 
strThisBook = Sheets("Options").Range("B5").Value 
strExtraInformation = Sheets("Options").Range("B6").Value 
strpathtoProj = Sheets("Options").Range("B7").Value 

'assign variable... this is here just in case they haven't ran the "TEST" button 

Application.ScreenUpdating = False 
Application.DisplayAlerts = False 
ActiveSheet.Unprotect 

'Remove any past data 
SHOW_WARNING (False) 
' Extended The Range To Remove data that continued below line 44. Brian 
1/20/2015 
' Range("C2:C200").ClearContents ' Jobs 
    Range("F4:S13").ClearContents ' Bar 
    Range("G17:G23").ClearContents ' Web Plate 
    Range("J17:J19").ClearContents ' Cable 
    Range("M17:M23").ClearContents ' Rod 
    Range("P17:P25").ClearContents ' Angle 
'Remove any past data 

'initialize ExtraInformation 
Sheets(strExtraInformation).Range("A1:K1000").ClearContents 
Sheets(strExtraInformation).Select 
Range("A1").Select 
'initialize ExtraInformation 

SHOW_SHEETS (True) 
INITIALIZE_PUBLIC_VARS 

IMPORT_ALL_INFORMATION 

PRINT_WEB_DATA 
PRINT_BAR_DATA 
PRINT_BRAC_DATA 
PRINT_ROD_DATA 
PRINT_ANGLE_DATA 

SHOW_SHEETS (False) 

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 
End Sub 

    Sub TEST_FOR_BAD_JOB_MUMBERS() 
    Dim bFound As Boolean 

    On Error GoTo EXPLAIN 

Application.ScreenUpdating = False 'increase performance 
Application.DisplayAlerts = False 

'Unhide all sheets 
Sheets("REPORT").Visible = True 
'Unhide all sheets 

'Get all of the settings for this macro and assign variables 
strpathtofile = Sheets("Options").Range("B3").Value 
strFilename = Sheets("Options").Range("B4").Value 
strpathtoProj = Sheets("Options").Range("B7").Value 
'Get all of the settings for this macro and assign variables 

Sheets("REPORT").Select 
ActiveSheet.Unprotect 

Range("C2").Select 

Do Until ActiveCell.Value = "" 
bFound = True 
Dim fso As Object 
Set fso = CreateObject("Scripting.FileSystemObject") 'Wow! What an 
efficiency increase! 
If Not fso.FileExists(strpathtofile & ActiveCell & strFilename) Then 'Wow! 
What an efficiency increase! 
    Error (53) 'file not found error 
End If 
ActiveCell.Font.Color = RGB(0, 0, 0) 
ActiveCell.Font.Bold = False 

ActiveCell.Offset(1, 0).Select 

Loop 
Range("c2").Select 

'Clean up the look of this thing! 
Sheets("Options").Visible = False 
Sheets("REPORT").Select 

If bFound Then 
MsgBox "Test Has Passed! All Job Numbers Found on X-Drive" 
Else 
MsgBox "No Jobs!" 
End If 

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 
Exit Sub 

EXPLAIN: 
'Clean up the look of this thing! 
Sheets("Options").Visible = False 
Sheets("REPORT").Select 
ActiveCell.Font.Color = RGB(255, 0, 0) 
ActiveCell.Font.Bold = True 
MsgBox "One Or More Jobs Do Not Exist. Please Check for RED Highlighted 
Job."  
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 
End Sub 

Sub IMPORT_ALL_INFORMATION() 

'Set variables 
Dim file_in As Long 
Dim strInput As Variant 

'end setting variables 
Sheets("REPORT").Select 
Range("C2").Select 

Do Until ActiveCell.Value = "" '//loop through each job 
    file_in = FreeFile 'next file number 
    strFileToOpen = strpathtofile & ActiveCell.Value & strFilename 
    Open strFileToOpen For Input As #file_in 

    Put_Data_In_Array (file_in) 
    Organize_Array_For_Print 

    Close #file_in ' close the file 
    file_in = file_in + 1 
    Sheets("REPORT").Select 
    ActiveCell.Offset(1, 0).Select 
    Loop 

    End Sub 

Answer 1

Gemessen an dem Titel Ihres Frage ist, was Sie brauchen, aber ich bin ein wenig verwirrt durch Ihre Frage:

sub MainSub() 
    FileOne = worksheets("SuperSecretHiddenSheet").range("A1").value 
    FileTwo = worksheets("SuperSecretHiddenSheet").range("A2").value 
    if bothfileExists(FileOne, FileTwo) = true then 
     'do stuff 
    end if 
End Sub 

function bothfileExists(ByRef FileOne as string, ByRef fileTwo as string) as boolean 
    if (dir(fileone) <> "" and dir(fileTwo) <> "") then 
     bothfileExists = True 
    else 
     bothfileExists = False 
    end if 
end function