简体   繁体   中英

VBA - Checking Two Different Path Locations

I have an existing VBA Project that I simply need to modify even if does scream to be re-written one day.

The sheet has a hidden sheet called Options that lists a file path in B3 and that path is called \\fileserver\\Drafting\\MBS_JOBS\\

The code then assigns a variable this path:

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

Finally, later on, it puts it all together with this:

strFileToOpen = strpathtofile & ActiveCell.Value & strFilename

What I need to do now is have it check a second path. So I've duplicated some of the code.

I first put the new path in B7 of the OPTIONS page. Then, I created a variable and assigned it:

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

So, what I need to do is have this program also check this other path. So wondering if I need some kind of IF, THEN or ELSE statement around this part:

strFileToOpen = strpathtofile & ActiveCell.Value & strFilename

To also make it look at strpathtoProj.

I'm a "work in progress" VBA developer as a SOLO IT guy for a small business and am learning as I go.

Here are the modules that use strpathtofile (and you can see that I've already got some code in there for the strpathtoProj that I now need to use):

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

Judging by the title of your question this is what you need, but I am a little confused by your question:

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM