Question

我有一个现有的VBA项目，我只需要修改即使有一天会重新写入。

工作表有一个名为Options的隐藏工作表，它列出了B3中的文件路径，该路径名为\ fileserver \ Drafting \ MBS_JOBS \

然后代码为此路径分配变量：

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

最后，稍后，它将所有内容与此结合起来：

strFileToOpen = strpathtofile & ActiveCell.Value & strFilename

我现在需要做的是检查第二条路径。所以我复制了一些代码。

我首先将新路径放在OPTIONS页面的B7中。然后，我创建了一个变量并分配了它：

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

所以，我需要做的是让这个程序也检查另一条路径。所以想知道我是否需要某种关于这部分的IF，THEN或ELSE声明：

strFileToOpen = strpathtofile & ActiveCell.Value & strFilename

还要看看strpathtoProj。

我是一名“正在进行中的工作”VBA开发人员，作为小型企业的SOLO IT人员，我正在学习。

以下是使用strpathtofile的模块（你可以看到我已经在那里获得了一些我现在需要使用的strpathtoProj的代码）：

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

根据你问题的标题判断这是你需要的，但我对你的问题感到有些困惑：

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

VBA - 检查两个不同的路径位置

1 个答案: