【问题标题】:Check availability of folder/files检查文件夹/文件的可用性
【发布时间】:2018-12-12 10:59:34
【问题描述】:
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

我编写了以下代码来检查用户桌面中的文件夹和该文件夹中的两个文件,然后更新用户表单中的三个复选框。

但是每次我运行它时,我都会得到不同的结果,无论所述文件夹中的文件是否可用。代码似乎在随机检查复选框。

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

【问题讨论】:

  • 不是为了积分,但我猜你选择 FSO 而不是 DIR?或者,也许您实际上没有理解我的回答?随意选择 Jeremy 的答案,但我建议使用(VBA 方法)Dir、FileCopy 和 Kill,而不是 FSO(FileSystemObject)。仅在必要时使用 FSO。
  • 嘿,抱歉,我很欣赏您的回答,但 Jimmy 的回答为我提供了我需要的即时解决方案,而对于您的解决方案,我不得不对代码进行一些试验。您能否分享在这种情况下使用 VBA 方法相对于 FSO 的优势?谢谢!

标签: excel vba


【解决方案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 的字符串变量中。可以直接做

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

【讨论】:

    【解决方案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
    

    【讨论】:

    • @NickRazzleflamm 没问题 :)
    猜你喜欢
    • 2014-11-03
    • 1970-01-01
    • 1970-01-01
    • 2020-01-22
    • 2014-11-18
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2012-05-11
    相关资源
    最近更新 更多