Question

Sub CWSSCheck()

If ActiveSheet.Name = "Position_by_Fixture" Then

Call FileCheck

ElseIf ActiveSheet.Name = "Group_PositionList" Then
MsgBox "This is the Group Position List. Convert the Shelfstock to the old 
format using the 'Convert Shelfstock' function and try again.", vbExclamation, "Invalid Format"

Else
MsgBox "This workbook doesn't have a Shelfstock sheet. Please open a valid Shelfstock file and try again.", vbExclamation, "Shelfstock Not Found"

End If
End Sub

Sub FileCheck()

'Check the REQUIRED FILES folder
UserForm1.Show

Dim RFPath As String
Dim UOLPath As String
Dim SOLPath As String

RFPath = ""
On Error Resume Next
RFPath = Environ("USERPROFILE") & "\Desktop\REQUIRED FILES\"
On Error GoTo 0

UOLPath = ""
On Error Resume Next
UOLPath = Environ("USERPROFILE") & "\Desktop\REQUIRED FILES\UPDATED_OUTLET_LIST.xlsx"
On Error GoTo 0

SOLPath = ""
On Error Resume Next
SOLPath = Environ("USERPROFILE") & "\Desktop\REQUIRED FILES\SAP_OUTLET_LIST.xlsx"
On Error GoTo 0

If RFPath = "" Then
    UserForm1.CheckBox3.Value = False
Else
    UserForm1.CheckBox3.Value = True
End If

If SOLPath = "" Then
    UserForm1.CheckBox2.Value = False
Else
    UserForm1.CheckBox2.Value = True
End If

If UOLPath = "" Then
    UserForm1.CheckBox1.Value = False
Else
    UserForm1.CheckBox1.Value = True
End 

End Sub

我编写了以下代码，以检查用户桌面中的文件夹以及该文件夹中的两个文件，然后在用户窗体中更新三个复选框。

但是，每次运行此命令时，无论上述文件夹中文件的可用性如何，我都会得到不同的结果。该代码似乎正在随机检查复选框。

我很难看到代码出了什么问题。任何帮助将不胜感激！

Answer 1

RFPath = ""
On Error Resume Next
RFPath = Environ("USERPROFILE") & "\Desktop\REQUIRED FILES\"
On Error GoTo 0

您正在字符串变量中创建路径，但不检查它是否存在。使用此功能

Public Function FileFolderExists(strFullPath As String) As Boolean
    On Error GoTo EarlyExit
    If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExists = True
EarlyExit:
    On Error GoTo 0
End Function

例如：

Debug.Print FileFolderExists(RFPath)

也可以将On Error Resume Next存储在String变量中。你可以直接做

RFPath = Environ("USERPROFILE") & "\Desktop\REQUIRED FILES\"

Answer 2

我建议您使用file scripting object来避免波动，如果循环该函数，可能会遇到问题：

Sub FileCheck()
Dim FSO As Object
Dim CheckForFolder As Boolean, CheckForFile1 As Boolean, CheckForFile2 As Boolean

Set FSO = CreateObject("Scripting.FileSystemObject")
CheckForFolder = False
CheckForFile1 = False
CheckForFile2 = False

'Check the REQUIRED FILES folder
UserForm1.Show

If FSO.FolderExists(Environ("USERPROFILE") & "\Desktop\REQUIRED FILES\") Then CheckForFolder = True ' Checks for the folder. If it exsists, set boolean to "True"

If FSO.FileExists(Environ("USERPROFILE") & "\Desktop\REQUIRED FILES\UPDATED_OUTLET_LIST.xlsx") Then CheckForFile1 = True ' Checks for the 1st file. If it exsists, set boolean to "True"

If FSO.FileExists(Environ("USERPROFILE") & "\Desktop\REQUIRED FILES\SAP_OUTLET_LIST.xlsx") Then CheckForFile2 = True ' Checks for the 2nd file. If it exsists, set boolean to "True"


If CheckForFolder = False Then ' Checks the boolean, asings the checkbox accordingly
    UserForm1.CheckBox3.Value = False
Else
    UserForm1.CheckBox3.Value = True
End If

If CheckForFile2 = False Then ' Checks the boolean, asings the checkbox accordingly
    UserForm1.CheckBox2.Value = False
Else
    UserForm1.CheckBox2.Value = True
End If

If CheckForFile1 = False Then ' Checks the boolean, asings the checkbox accordingly
    UserForm1.CheckBox1.Value = False
Else
    UserForm1.CheckBox1.Value = True
End

Set FSO = Nothing 'Tidy up the memory

End Sub

检查文件夹/文件的可用性

2 个答案: