Question

我正在尝试从特定单元格的文件夹中的多个.xlsm扩展数据。这个想法是要使用一个包含多个.xlsm文件的文件夹，然后将一个特定的单元格提取到我当前的工作簿中。

查看代码。

Option Explicit


Const FOLDER_PATH = "C:\Users\maxd\OneDrive - Nortek, Inc\Coil Test Data\coils_35_and_36\36\WET\Testing\"  'REMEMBER END BACKSLASH


Sub ImportWorksheets()
   '=============================================
   'Process all Excel files in specified folder
   '=============================================
   Dim sFile As String           'file to process
   Dim wsTarget As Worksheet
   Dim wbSource As Workbook
   Dim wsSource As Worksheet
   Dim rowTarget As Long         'output row

   rowTarget = 7

   'check the folder exists
   If Not FileFolderExists(FOLDER_PATH) Then
      MsgBox "Specified folder does not exist, exiting!"
      Exit Sub
   End If

   'reset application settings in event of error
   'On Error GoTo errHandler
   'Application.ScreenUpdating = False

   'set up the target worksheet
   Set wsTarget = Sheets("Sheet1")

   'loop through the Excel files in the folder
   sFile = Dir(FOLDER_PATH & "*.xlsm*")
   Do Until sFile = ""

      'open the source file and set the source worksheet - ASSUMED WORKSHEET(1)
      Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
      Set wsSource = wbSource.Worksheets("Summary")


      'import the data
      With wsTarget
         .Range("I" & rowTarget).Value = wsSource.Range("B25").Value


         'optional source filename in the last column
         .Range("N" & rowTarget).Value = sFile
      End With

      'close the source workbook, increment the output row and get the next file
      wbSource.Close SaveChanges:=False
      rowTarget = rowTarget + 1
      sFile = Dir()
   Loop

errHandler:
   On Error Resume Next
   Application.ScreenUpdating = True

   'tidy up
   Set wsSource = Nothing
   Set wbSource = Nothing
   Set wsTarget = Nothing
End Sub




Private Function FileFolderExists(strPath As String) As Boolean
    If Not Dir(strPath, vbDirectory) = vbNullString Then FileFolderExists = True
End Function

实际结果=它什么也不做，就好像文件夹中没有文件。

预期结果=它将从单元格B25中提取数据并将其插入到我当前工作表的I7中。

编辑：当我通过代码F8时，它变成“ Set wsSource = wbSource.Worksheets（“ Summary”）“”然后我得到一个运行时错误91

从源文件夹提取所有数据

0 个答案: