Я пытаюсь взять одну ячейку данных из определенных файлов в очень большой папке. В настоящее время у меня есть это:
Sub ExtractDataToDifferentSheets()
On Error GoTo HandleError
Application.ScreenUpdating = False
Dim rowNumber As Integer
rowNumber = Worksheets("sheet1").UsedRange.rows.Count
For dRow = 2 To rowNumber
Dim NG As String
Dim Lot As String
NG = Application.Workbooks(1).ActiveSheet.Cells(dRow, 1)
Lot = Application.Workbooks(1).ActiveSheet.Cells(dRow, 2)
Dim objectFlieSys As Object
'Dim objectGetFile As Object
Dim file As Object
Set objectFlieSys = CreateObject("Scripting.FileSystemObject")
Set file = objectFlieSys.GetFile(StringFormat("C:\Users\mmccarthy\Box\QC-QA\SOPS Quality System\Quality logs\Ingredient Release Forms Records\2022 INGREDIENT RELEASE FORM\{0}_{1}.xlsx", NG, Lot)) ' The folder location of the source files.
Application.Workbooks(1).ActiveSheet.Cells(dRow, 7) = _
file.Worksheets("Sheet1").Cells(7, 7)
file.Close False
Set file = Nothing
Next
HandleError:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
У меня нет большого опыта работы с VBA, я работал со следующим примером:
Sub ExtractDataToDifferentSheets()
On Error GoTo HandleError
Application.ScreenUpdating = False
Dim rowNumber As Integer
rowNumber = Worksheets("sheet1").UsedRange.rows.Count
For dRow = 2 To rowNumber
Dim NG As String
Dim Lot As String
NG = Application.Workbooks(1).ActiveSheet.Cells(dRow, 1)
Lot = Application.Workbooks(1).ActiveSheet.Cells(dRow, 2)
Dim objectFlieSys As Object
'Dim objectGetFile As Object
Dim file As Object
Set objectFlieSys = CreateObject("Scripting.FileSystemObject")
Set file = objectFlieSys.GetFile(StringFormat("C:...\2022 INGREDIENT RELEASE FORM\{0}_{1}.xlsx", NG, Lot)) ' The folder location of the source files.
Application.Workbooks(1).ActiveSheet.Cells(dRow, 7) = _
file.Worksheets("Sheet1").Cells(7, 7)
file.Close False
Set file = Nothing
Next
HandleError:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Я знаю, что это не лучший пример для работы, но изначально я намеревался извлечь данные из всех файлов в папке, но это заняло слишком много времени, поэтому я ограничил его теми, которые мне нужны. Когда я написал другой скрипт для извлечения одной и той же информации из каждого файла в папке, он запустился, но произошел сбой системы, и я не сохранил его, поэтому весь код был потерян.
Что особенно сбивает с толку, так это то, что он выделяет первую строку кода, когда выдает ошибку. У меня складывается впечатление, что он говорит мне, что подсистема, которую я пытаюсь определить, не определена. Это было бы глупо. Есть ли в моем коде опечатка, которую я не могу найти? Я понятия не имею, почему предыдущий код запускался, когда этот код немедленно выдает ошибки. это кажется наиболее актуальным вопросом, который я мог найти о переполнении стека, но я не могу найти «создать», на который ссылается ответ.
Пожалуйста, помогите, иначе я проведу все выходные вручную копируя данные для этой невероятно простой задачи. :(
Настоятельно рекомендуется включить Option Explicit при написании файла marco. (Находится в VBA-> Инструменты-> Вкладка «Редактор»-> Требовать объявление переменной).
Это заставит вас определить (Dim) ваши строки, переменные, рабочие книги, имена листов и т. д.
Я бы проверил, что "лист1" не должен быть заглавной буквой S "Лист1"
В качестве альтернативы, изменение («лист1») на просто (1) пометит первый лист в этой книге.
Например.
rowNumber = Рабочие листы("лист1").UsedRange.rows.Count
станет
rowNumber = Рабочие листы (1).UsedRange.rows.Count
Я ценю вашу помощь, но я не уверен, какую строку мне не удалось определить? у меня нет определенных строковых переменных, которые я вижу, только строка, возвращаемая функцией string.format. Нужно ли мне определить это как именованную переменную, а затем передать ее другой функции?
Option Explicit
Sub ImportData()
Dim IsSuccess As Boolean
On Error GoTo ClearError
' Define constants.
Const SOURCE_SUBFOLDER_PATH As String _
= "Box\QC-QA\SOPS Quality System\Quality logs" _
& "\Ingredient Release Forms Records\2022 INGREDIENT RELEASE FORM"
Const SOURCE_FILE_EXTENSION As String = ".xlsx"
Const NG_LOT_DELIMITER As String = "_"
' Build the Source folder path.
Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
Dim SourceFolderPath As String: SourceFolderPath _
= fso.BuildPath(Environ("USERPROFILE"), SOURCE_SUBFOLDER_PATH)
If Not fso.FolderExists(SourceFolderPath) Then
MsgBox "The folder '" & SourceFolderPath & "' doesn't exist.", _
vbExclamation
Exit Sub
End If
' Destination
Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
Dim dws As Worksheet: Set dws = dwb.Worksheets("Sheet1")
Dim dlRow As Long: dlRow = dws.UsedRange.Rows.Count
' Copy.
Application.ScreenUpdating = False
Dim swb As Workbook
Dim sws As Worksheet
Dim SourceFileName As String
Dim SourceFilePath As String
Dim NG As String
Dim Lot As String
Dim dRow As Long
For dRow = 2 To dlRow
' Build the Source file path.
NG = CStr(dws.Cells(dRow, "A").Value)
Lot = CStr(dws.Cells(dRow, "B").Value)
SourceFileName = NG & NG_LOT_DELIMITER & Lot & SOURCE_FILE_EXTENSION
SourceFilePath = fso.BuildPath(SourceFolderPath, SourceFileName)
If fso.FileExists(SourceFilePath) Then ' file found
' Open, copy and close.
Set swb = Workbooks.Open(SourceFilePath, True, True)
Set sws = swb.Worksheets("Sheet1")
dws.Cells(dRow, "G").Value = sws.Range("G7").Value
swb.Close SaveChanges:=False
Else ' file not found
'dws.Cells(dRow, "G").ClearContents
End If
Next dRow
IsSuccess = True
ProcExit:
On Error Resume Next
If Not Application.ScreenUpdating Then Application.ScreenUpdating = True
If IsSuccess Then
MsgBox "Data imported.", vbInformation
Else
MsgBox "Something went wrong.", vbCritical
End If
On Error GoTo 0
Exit Sub
ClearError:
Debug.Print "Run-time error '" & Err.Number & "':" & Err.Description
Resume ProcExit
End Sub
Спасибо, это в основном работает, и я думаю, что любые незаполненные данные - это просто проблема с моим набором данных. Это намного сложнее, чем я думал! мне придется просмотреть его в глубину, чтобы лучше понять.
What is especially confusing is it highlights the first line of code
- да, в желтом. Он также выделяет что-то еще синим цветом. Ты это видишь?