VBA - Open file from a specific folder and do action - vba

Question

I want to open files from a specific folder and do the actions with my code below.
But when VBA opens the first file, it stops.
Please help me!
Sub ExtractData?()
'
' ExtractData? Macro
'
' Keyboard Shortcut: Ctrl+Shift+Q
'
Dim buf As String
Dim dlg As FileDialog
Dim fold_path As String
Application.ScreenUpdating = False
Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
If dlg.Show = False Then Exit Sub
fold_path = dlg.SelectedItems(1)
buf = Dir(fold_path & "\*.xlsx")
Do While buf <> ""
Workbooks.Open fold_path & "\" & buf
Sheets("データセット1").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("Workbook.xlsm").Activate
Sheets("GE").Select
Cells(Range("A65536").End(xlUp).Row + 1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(buf).Close SaveChanges:=False
buf = Dir()
Loop
End Sub

Answer 1

The error is not coming from your Do While buf <> "" loop, but from what you are trying to achieve inside (copy >> paste between workbooks).
Inside your loop, you have too many Select, Selection and Activate, instead use fully qualifed Range and Cells.
You can use With openWB.Worksheets("データセット1"), and below it nest your range with .Range(.Cells(2, "A"), .Cells(LastRow, LastCol)).Copy.
Code
Sub ExtractData①()
' ExtractData? Macro
' Keyboard Shortcut: Ctrl+Shift+Q
'
Dim buf As String
Dim dlg As FileDialog
Dim fold_path As String
Dim openWB As Workbook
Dim LastRow As Long, LastCol As Long
Application.ScreenUpdating = False
Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
If dlg.Show = False Then Exit Sub
fold_path = dlg.SelectedItems(1)
buf = Dir(fold_path & "\*.xlsx")
Application.DisplayAlerts = False
Do While buf <> ""
Set openWB = Workbooks.Open(fold_path & "\" & buf) '<-- set open workbook to object
With openWB.Worksheets("データセット1") '<-- not sure about this name (I don't have this font)
' set the range from A2 to last cell with data in sheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
.Range(.Cells(2, "A"), .Cells(LastRow, LastCol)).Copy
End With
' if "Workbook.xlsm" is this workbook with the code, could be repalced with ThisWorkbook
With Workbooks("Workbook.xlsm").Worksheets("GE")
.Range("A" & .Cells(.Rows.Count, "A").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
openWB.Close False
buf = Dir()
Loop
' restore settings
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Answer 2

While your code works for me, using Select, Selection and Activate is pretty prone to error, especially when used in loops or when working in several workbooks.
Using nested With Objects makes it saver, faster and readable without forcing you to Dim and Set a ton of object variables. Try this:
On Error Goto catch:
try:
With Workbooks.Open(fold_path & "\" & buf)
With .Sheets("データセット1").Range("A2")
Range(.Cells(1, 1).End(xlToRight), .End(xlDown)).Copy
End With
With ThisWorkbook.Sheets("GE")
.Cells(Range("A65536").End(xlUp).Row + 1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
finally:
.Close SaveChanges:=False
End With
' rest of your code
Exit Sub
catch:
Debug.Print "Err at File " & buf & vbCrLf & Err & vbTab & Error
GoTo finally
Addidional notes:
.End(...) will get wrong results if there is an empty cell on the left or top border of your data range.
above is a simple example of an error handling routine, using pseudo try, catch, finally. Make sure you don't create any infinite loops (meaning: only execute bullet-proof code after the finally and add Exit Sub above the catch:
there are rare cases where the use of .Copy and .PasteSpecial makes sense.
However, in your case it's save to assume that there are simpler, faster and more fail proof options:
Range1.Value = Range2.Value, which writes the data in one step (therefore it's not simply screwed by user interactions, like .Copy + .Paste is
Read the data into an Array or better a Recordset, which allows additional processing, like filtering out empty rows
pull data with an ADO.Connection and SQL, which, you guessed it, allows even simpler processing and doesnt need the .Open + .Close and switching between workbooks
Hope that helps!