簡體   English   中英

VBA 檢查文件是否存在

[英]VBA check if file exists

我有這個代碼。 它應該檢查文件是否存在,如果存在則打開它。 如果文件存在,它就可以工作;但是,如果文件不存在,每當我將文本框留空並單擊提交按鈕時,它就會失敗。 如果文本框為空,我想要的是顯示錯誤消息,就像文件不存在一樣。

運行時錯誤“1004”

Dim File As String
File = TextBox1.Value
Dim DirFile As String

DirFile = "C:\Documents and Settings\Administrator\Desktop\" & File
If Dir(DirFile) = "" Then
  MsgBox "File does not exist"
Else
    Workbooks.Open Filename:=DirFile
End If

像這樣的東西

最好使用工作簿變量來提供對打開的工作簿的進一步控制(如果需要)

更新以測試該文件名是一個實際的工作簿 - 這也使初始檢查變得多余,除了向用戶發送消息而不是文本框為空

Dim strFile As String
Dim WB As Workbook
strFile = Trim(TextBox1.Value)
Dim DirFile As String
If Len(strFile) = 0 Then Exit Sub

DirFile = "C:\Documents and Settings\Administrator\Desktop\" & strFile
If Len(Dir(DirFile)) = 0 Then
  MsgBox "File does not exist"
Else
 On Error Resume Next
 Set WB = Workbooks.Open(DirFile)
 On Error GoTo 0
 If WB Is Nothing Then MsgBox DirFile & " is invalid", vbCritical
End If

我使用這個函數來檢查文件是否存在:

Function IsFile(ByVal fName As String) As Boolean
'Returns TRUE if the provided name points to an existing file.
'Returns FALSE if not existing, or if it's a folder
    On Error Resume Next
    IsFile = ((GetAttr(fName) And vbDirectory) <> vbDirectory)
End Function

為了檢查存在,還可以使用(適用於文件和文件夾)

Not Dir(DirFile, vbDirectory) = vbNullString

如果文件或目錄存在,則結果為True

例子:

 If Not Dir("C:\\Temp\\test.xlsx", vbDirectory) = vbNullString Then MsgBox "exists" Else MsgBox "does not exist" End If

一種干凈而簡短的方式:

Public Function IsFile(s)
    IsFile = CreateObject("Scripting.FileSystemObject").FileExists(s)
End Function

可能是由Filename變量引起的

File = TextBox1.Value

它應該是

Filename = TextBox1.Value

各種 FileExists 方法的速度

我需要為我的許多項目檢查文件是否存在,所以我想確定最快的選項。 我使用微型計時器代碼(參見基准測試 VBA 代碼)針對包含 2865 個文件的本地文件夾運行表下方的文件存在函數,以查看哪個更快。 獲勝者使用了 GetAttr。 對於定義為全局的 object,使用 FSO 方法進行測試 2 的速度要快一些,但不如 GetAttr 方法快。

------------------------------------------------------
% of Fastest                Seconds       Name
------------------------------------------------------
100.00000000000%             0.0237387    Test 1 - GetAttr
7628.42784145720%            1.8108896    Test 2 - FSO (Obj Global)
8360.93687615602%            2.0522254    Test 2 - FSO (Obj in Function)
911.27399562739%             0.2163246    Test 3 - Dir
969.96844814586%             0.2302579    Test 4 - Dir$
969.75108156723%             0.2302063    Test 5 - VBA.Dir
933.82240813524%             0.2216773    Test 6 - VBA.Dir$
7810.66612746275%            1.8541506    Test 7 - Script.FSO

Function FileExistsGA(ByVal FileSpec As String) As Boolean
  ' Karl Peterson MS VB MVP
  Dim Attr As Long
  ' Guard against bad FileSpec by ignoring errors
  ' retrieving its attributes.
  On Error Resume Next
  Attr = GetAttr(FileSpec)
  If Err.Number = 0 Then
    ' No error, so something was found.
    ' If Directory attribute set, then not a file.
    FileExistsGA = Not ((Attr And vbDirectory) = vbDirectory)
  End If
End Function

Function FSOFileExists(sFilePathNameExt As String) As Boolean
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    FSOFileExists = fso.FileExists(sFilePathNameExt)
    Set fso = Nothing
End Function

Function FileExistsDir(sFilePathNameExt As String) As Boolean
    If Len(Dir(sFilePathNameExt)) > 0 Then FileExistsDir = True
End Function

Function FileExistsDirDollar(sFilePathNameExt As String) As Boolean
    If Len(Dir$(sFilePathNameExt)) > 0 Then FileExistsDirDollar = True
End Function

Function FileExistsVBADirDollar(sFilePathNameExt As String) As Boolean
    If Len(VBA.Dir$(sFilePathNameExt)) > 0 Then FileExistsVBADirDollar = True
End Function

Function FileExistsVBADir(sFilePathNameExt As String) As Boolean
    If Len(VBA.Dir(sFilePathNameExt)) > 0 Then FileExistsVBADir = True
End Function

Public Function IsFileSFSO(s)
    IsFileSFSO = CreateObject("Scripting.FileSystemObject").FileExists(s)
End Function

我意識到這並沒有完全回答 OP,但提供了關於所提供的答案似乎最有效的信息。

我會把它扔到那里然后躲起來。 檢查文件是否存在的通常原因是為了避免在嘗試打開文件時出錯。 如何使用錯誤處理程序來處理:

Function openFileTest(filePathName As String, ByRef wkBook As Workbook, _
                      errorHandlingMethod As Long) As Boolean
'Returns True if filePathName is successfully opened,
'        False otherwise.
   Dim errorNum As Long

'***************************************************************************
'  Open the file or determine that it doesn't exist.
   On Error Resume Next:
   Set wkBook = Workbooks.Open(fileName:=filePathName)
   If Err.Number <> 0 Then
      errorNum = Err.Number
      'Error while attempting to open the file. Maybe it doesn't exist?
      If Err.Number = 1004 Then
'***************************************************************************
      'File doesn't exist.
         'Better clear the error and point to the error handler before moving on.
         Err.Clear
         On Error GoTo OPENFILETEST_FAIL:
         '[Clever code here to cope with non-existant file]
         '...
         'If the problem could not be resolved, invoke the error handler.
         Err.Raise errorNum
      Else
         'No idea what the error is, but it's not due to a non-existant file
         'Invoke the error handler.
         Err.Clear
         On Error GoTo OPENFILETEST_FAIL:
         Err.Raise errorNum
      End If
   End If

   'Either the file was successfully opened or the problem was resolved.
   openFileTest = True
   Exit Function

OPENFILETEST_FAIL:
   errorNum = Err.Number
   'Presumabley the problem is not a non-existant file, so it's
   'some other error. Not sure what this would be, so...
   If errorHandlingMethod < 2 Then
      'The easy out is to clear the error, reset to the default error handler,
      'and raise the error number again.
      'This will immediately cause the code to terminate with VBA's standard
      'run time error Message box:
      errorNum = Err.Number
      Err.Clear
      On Error GoTo 0
      Err.Raise errorNum
      Exit Function

   ElseIf errorHandlingMethod = 2 Then
      'Easier debugging, generate a more informative message box, then terminate:
      MsgBox "" _
           & "Error while opening workbook." _
           & "PathName: " & filePathName & vbCrLf _
           & "Error " & errorNum & ": " & Err.Description & vbCrLf _
           , vbExclamation _
           , "Failure in function OpenFile(), IO Module"
      End

   Else
      'The calling function is ok with a false result. That is the point
      'of returning a boolean, after all.
      openFileTest = False
      Exit Function
   End If

End Function 'openFileTest()

這是我更新的代碼。 在保存之前檢查版本是否存在並保存為下一個可用版本號。

Sub SaveNewVersion()
    Dim fileName As String, index As Long, ext As String
    arr = Split(ActiveWorkbook.Name, ".")
    ext = arr(UBound(arr))

    fileName = ActiveWorkbook.FullName

    If InStr(ActiveWorkbook.Name, "_v") = 0 Then
        fileName = ActiveWorkbook.Path & "\" & Left(ActiveWorkbook.Name, InStr(ActiveWorkbook.Name, ".") - 1) & "_v1." & ext
    End If

   Do Until Len(Dir(fileName)) = 0

        index = CInt(Split(Right(fileName, Len(fileName) - InStr(fileName, "_v") - 1), ".")(0))
        index = index + 1
        fileName = Left(fileName, InStr(fileName, "_v") - 1) & "_v" & index & "." & ext

    'Debug.Print fileName
   Loop

    ActiveWorkbook.SaveAs (fileName)
End Sub
Function FileExists(ByRef strFileName As String) As Boolean
' TRUE if the argument is an existing file
' works with Unicode file names
    On Error Resume Next
    Dim objFSO As Object
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    FileExists = objFSO.FileExists(strFileName)
    On Error GoTo 0
End Function

為了使函數運行得更快,可以將 objFSO 設為全局變量,並且可以修改代碼並將其保存在一個模塊中,如下所示:

Option Explicit
Dim objFSO As Object
Function FileExists(ByRef strFileName As String) As Boolean
' TRUE if the argument is an existing file
' works with Unicode file names
    On Error Resume Next
    If objFSO Is Nothing Then Set objFSO = CreateObject("Scripting.FileSystemObject")
    FileExists = objFSO.FileExists(strFileName)
    On Error GoTo 0
End Function

要使strFileName成為 unicode 字符串,例如,您可以從單元格值中獲取它或以特殊方式定義它,因為 Excel 的 VBE 不會以 Unicode 格式保存字符串常量。 VBE 確實支持已保存在字符串變量中的 Unicode 字符串。 您將不得不查找此內容以獲取更多詳細信息。

希望這對某人有幫助^_^

您應該設置一個條件循環來檢查 TextBox1 值。

If TextBox1.value = "" then
   MsgBox "The file not exist" 
   Exit sub 'exit the macro
End If

希望對你有幫助。

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM