Извлечь все данные из исходной папки - PullRequest
0 голосов
/ 13 июня 2019

Я пытаюсь извлечь дополнительные данные из нескольких .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

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...