0

我在 Excel 中编写了一个 VBA 宏，它应该具有以下内容：

  1. 给定以下路径循环遍历该路径中的子文件夹（所有子文件夹都以序列号开头）
  2. 进入定义为输入的数字窗口中的子文件夹（例如 Start_i=76，Finish_i=106）并搜索与该子文件夹同名的 excel 文件（.xlsx 或 .xlsm）
  3. 打开它，更改一些特定的单元格，保存并关闭文件
  4. 转到窗口中的下一个子文件夹 [76, 106]

到目前为止，一切都很好。

问题，我有一个包含 2 个文件（.pdf 和 .xlxs）的文件夹，程序返回了我的 3 个文件（.pdf 和 2x .xlxs）

在此处输入图像描述

Option Explicit
Sub BaKo_Check()
         Dim Name As String, Fa As String, Anlage As String, projekt As String, auxStringPath As String
         Dim Datum As Date
         Dim BeMi As Integer, Start_i As Integer, Finish_i As Integer, BaKo_Nr As Integer
         Dim FSO As New FileSystemObject
         Dim objFSO As Object
         Dim objFolder As Object
         Dim objSubFolder As Object
         Dim file As Object
         Dim fileName As String

     'Get Data from Input Window
     Fa = Range("I2").Text
     projekt = Range("I3").Text
     Name = Range("I4").Text
     Datum = Range("I5").Value
     Start_i = ThisWorkbook.Sheets("Sheet1").Range("I10").Value
     Finish_i = ThisWorkbook.Sheets("Sheet1").Range("I11").Value
     auxStringPath = Range("I8").Text

     'Error Control
     If auxStringPath = "" Then
        Err = 19
        GoTo handleCancel
     End If

     'Create an instance of the FileSystemObject
     Set objFSO = CreateObject("Scripting.FileSystemObject")

     'Get the folder object
     Set objFolder = objFSO.GetFolder(auxStringPath)

     'Loop through subfolders in main Folder
     For Each objSubFolder In objFolder.subfolders
     BaKo_Nr = CInt(Left(objSubFolder.Name, 3))
          If BaKo_Nr >= Start_i Then
               If BaKo_Nr <= Finish_i Then

                    'Loop trough Files in SubFolders
                    For Each file In objSubFolder.Files
                         fileName = FSO.getfilename(CStr(file))
                              If FSO.GetExtensionName(CStr(file)) = "xlsx" Or FSO.GetExtensionName(CStr(file)) = "xlsm" Then
                                   Workbooks.Open fileName:=file
                                   Workbooks(fileName).Sheets("BaKo_neu").Range("C4").Value = projekt
                                   Workbooks(fileName).Sheets("BaKo_neu").Range("C53").Value = Name
                                   Workbooks(fileName).Sheets("BaKo_neu").Range("C54").Value = Datum
                                   Workbooks(fileName).Sheets("BaKo_neu").Range("H2").Value = Fa
                                   Workbooks(fileName).Sheets("BaKo_neu").Range("H4").Value = Mid(fileName, 10, 6)
                                        ThisWorkbook.Sheets("Sheet1").Range("E23").Value = Mid(fileName, 10, 6)
                                   Workbooks(fileName).Sheets("BaKo_neu").Range("C2").Value = ThisWorkbook.Sheets("Sheet1").Range("F23").Value
                                   Workbooks(fileName).Save
                                   Workbooks(fileName).Close
                              End If
                    Next file
               End If
          End If
     Next objSubFolder

handleCancel:
    If Err = 19 Then
        MsgBox "Missing Path"
    End If 

End Sub

第一个和第二个文件的代码功能，但是当它进入第三个文件时它崩溃了......

有人可以帮我吗？非常感谢

不可见文件将显示在我的笔记本电脑上

4

1 回答 1

0

谢谢蒂姆，解决了我的问题。我已经将一条线与属性规范集成在一起，并且运行平稳：

 For Each file In objSubFolder.Files
                         fileName = FSO.getfilename(CStr(file))
                              *If file.Attributes <> 32 Then Exit For*
于 2020-03-22T09:10:07.060 回答