excel VBA函数,仅当文件可以打开且没有任何错误时才返回值

wdebmtf2  于 2023-01-27  发布在  其他
关注(0)|答案(1)|浏览(137)

我正在写一个Excel VBA代码来检查有多少文件夹中的文件被损坏。一个名为“文件夹”在“E”驱动器中的文件夹有这些PDF文件。
在我的练习册中;Sheet 1的A列有来自这个文件夹的文件名。我有一个代码循环通过A列的filesNames并打开它们。

我的目标是:文件是否可以打开;则不在相邻单元格(B列)中打印任何内容,否则打印为“Corrupt”。

但是,当我运行VBA代码时当每次循环到Function OpenPDFPage()时,它不会在B列的相邻单元格中打印任何内容。(我只想在文件损坏时打印它,并收到消息框,显示“打开此文档时出错。文件已损坏,无法修复”)
我可以知道我必须作出什么样的改变函数OpenPDFPage(),以便当有一个损坏的文件(或文件无法打开)在文件夹中;则只有代码将在列B的相邻单元中打印“讹误”。
代码如下所示:

Option Explicit
    
Function OpenPDFPage(PDFPath As String) As Boolean

    On Error GoTo Error_OpenPDFPage
    ThisWorkbook.FollowHyperlink PDFPath, NewWindow:=True
    OpenPDFPage = True

    Exit_OpenPDFPage:
    Exit Function

    Error_OpenPDFPage:
    MsgBox Err & ": " & Err.Description
    OpenPDFPage = False
    Resume Exit_OpenPDFPage

End Function
    
Sub Test()
        
        Dim MyFolder As String
        Dim filename As Range
        Dim MyFile As String
        Dim lastRow As Long
        lastRow = Sheets("Sheet1").UsedRange.Rows.Count
    
        MyFolder = "E:\Folder"
        For Each filename In Worksheets("Sheet1").Range("A2:A" & lastRow)
    
        MyFile = MyFolder & "\" & filename
    
        If OpenPDFPage(MyFile) = True Then
        'Do Nothing
        Else
        filename.Offset(0, 1).Value = "Corrupt"
        End If              
    
        Next
End Sub
nx7onnlm

nx7onnlm1#

添加了另一个宏到上面;检查文件是否打开;如果它不是通过以前的宏打开,那么我假设它是腐败;并且在列B的相邻单元中打印为“损坏”。

Sub IsFileOpened()

    Dim MyFolder As String
    Dim filename As Range
    Dim MyFile As String
    Dim lastRow As Long
    lastRow = Sheets("Sheet1").UsedRange.Rows.Count

    MyFolder = "E:\Folder"
    For Each filename In Worksheets("Sheet1").Range("A1:A" & lastRow)
        MyFile = MyFolder & "\" & filename        
        If IsFileOpen(MyFile) = True Then
           ' Do Nothing
       Else
           filename.Offset(0, 1).Value = "Corrupt"
       End If
    Next
End Sub

   Function IsFileOpen(filename As String) As Boolean

       Dim filenum As Integer, errnum As Integer

       On Error Resume Next   
       filenum = FreeFile()   

       'Attempt to open the file and lock it.

       Open filename For Input Lock Read As #filenum
       Close filenum          ' Close the file.
       errnum = Err           ' Save the error number that occurred.
       On Error GoTo 0        ' Turn error checking back on.

       ' Check to see which error occurred.
       Select Case errnum

           Case 0
               IsFileOpen = False

           Case 70
               IsFileOpen = True

           ' Another error occurred.
           'Case Else
               'Error errnum
       End Select
   End Function

相关问题