VBA Run time error

Mr2017

Well-known Member
Joined
Nov 28, 2016
Messages
634
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi

I'm trying to import 3 files from a folder called "ExcelFilesToImport" that sits within in the Documents path.

But I get a run time error that says "Sorry, we couldn't find Apples.xlsx. It is possible it was moved, renamed or deleted." (see first screenshot attached).

However, the file is definitely an xlsx file and hasn't been moved, renamed or deleted (see second screenshot attached). When you right-click on it and click on Properties, the type is "Microsoft Excel Worksheet (.xlsx)"

Does anyone know what needs to be corrected in the code at the bottom of this message, please?

The files I'm importing are simple:

File 1 is called Apples and has the text 'Apples' in B3 and the number 1 in B4.
File 2 is called Bananas and has the text 'Bananas' in B3, the number 2 in B4, and the number 3 in B5.
File 3 is called Pears and has the text 'Pears' in B3, the number 3 in B4, and the number 4 in B5 and the number 5 in B6.

I'd like to import all of them, so that the data from each file is pasted into one tab in the active file with the macro.

But I'd like to ensure there is a blank row between the data from each file.

Eg if data from File 1 populates cells B3 and B4 in the imported data tab, then data from File 2 would populate cells B5 (row 4 would be blank) and B6.


VBA Code:
Sub ImportInto1Tab()

  Dim FolderPath As String, Filename As String, Sheet As Worksheet, sh As Worksheet

  Dim lr As Long, lc As Long, lr1 As Long

 

  Application.ScreenUpdating = False

  Path = "C:\Users\" & Environ("UserName") & "\Documents\ExcelFilesToImport\"

  'FolderPath = Environ("userprofile") & "\Desktop\Test\"

  'Filename = Dir(FolderPath & "*.xls*")

  Filename = Dir(Path & "*.xls")

  Set sh = Sheets.Add(before:=Sheets(1))

 

  Do While Filename <> ""

    Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True

    For Each Sheet In ActiveWorkbook.Sheets

      lr = Sheet.UsedRange.Rows(Sheet.UsedRange.Rows.Count).Row

      lc = Sheet.UsedRange.Columns(Sheet.UsedRange.Columns.Count).Column

      lr1 = sh.UsedRange.Rows(sh.UsedRange.Rows.Count).Row + 1

      Sheet.Range("A1", Sheet.Cells(lr, lc)).Copy sh.Range("A" & lr1)

    Next Sheet

    Workbooks(Filename).Close

    Filename = Dir()

  Loop

 

  Application.ScreenUpdating = True

End Sub




TIA
 

Attachments

  • screenshot of VBA error.PNG
    screenshot of VBA error.PNG
    47.8 KB · Views: 3
  • screenshot of files in their location.PNG
    screenshot of files in their location.PNG
    23.6 KB · Views: 3

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
Try this:

VBA Code:
Sub ImportInto1Tab()
  Dim sPath As String, sFile As String
  Dim wb As Workbook, sh As Worksheet, sh2 As Worksheet
  Dim lr1 As Long

  Application.ScreenUpdating = False

  With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select Folder"
    .AllowMultiSelect = False
    If .Show <> -1 Then Exit Sub
    sPath = .SelectedItems(1) & "\"
  End With
  sFile = Dir(sPath & "*.xls")
  Set sh = Sheets.Add(before:=Sheets(1))

  Do While sFile <> ""
    Set wb = Workbooks.Open(Filename:=sPath & sFile, ReadOnly:=True)
    For Each sh2 In wb.Sheets
      lr1 = sh.UsedRange.Rows(sh.UsedRange.Rows.Count).Row + 1
      sh2.Range("A1", sh2.UsedRange).Copy sh.Range("A" & lr1)
    Next
    wb.Close False
    sFile = Dir()
  Loop
  Application.ScreenUpdating = True
End Sub
 

Some videos you may like

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

Mr2017

Well-known Member
Joined
Nov 28, 2016
Messages
634
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi Dante

Thanks for the prompt response.

I tried that and it worked up to the part where it allows a user to select the folder they want to import the files from.

But then then the folder said "No items match your search" and the folder was empty." and the code stopped at this line:

If .Show <> -1 Then Exit Sub

The folder has 3 .xlsx files, so I added an 'x' at the end of the '.xls' in the code to see if it would make a difference. But it didn't....

Do you know why it wouldn't show any files to select, even though there are some .xlsx files in the folder?

I also changed a couple of the files to .xls files (without the 'x' at the end), but it still said the folder was empty?

Your help, so far, is greatly appreciated!

Thanks in advance.
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
Change this
VBA Code:
sFile = Dir(sPath & "*.xls")

For this:
VBA Code:
sFile = Dir(sPath & "*.xls*")

They must select the folder correctly:

1597933604115.png
 

Mr2017

Well-known Member
Joined
Nov 28, 2016
Messages
634
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hmmm...I tried that, but it still doesn't show any files?

This is the udpdated code with the 'x' after the 's' in "*.xls"

I tried it without the 'x' as well..., but the files I have are .xlsx files.

VBA Code:
Sub ImportInto1Tab()
  Dim sPath As String, sFile As String
  Dim wb As Workbook, sh As Worksheet, sh2 As Worksheet
  Dim lr1 As Long

  Application.ScreenUpdating = False

  With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select Folder"
    .AllowMultiSelect = False
    If .Show <> -1 Then Exit Sub
    sPath = .SelectedItems(1) & "\"
  End With
  'sFile = Dir(sPath & "*.xlsx")
  sFile = Dir(sPath & "*.xlsx*")
  Set sh = Sheets.Add(before:=Sheets(1))

  Do While sFile <> ""
    Set wb = Workbooks.Open(Filename:=sPath & sFile, ReadOnly:=True)
    For Each sh2 In wb.Sheets
      lr1 = sh.UsedRange.Rows(sh.UsedRange.Rows.Count).Row + 1
      sh2.Range("A1", sh2.UsedRange).Copy sh.Range("A" & lr1)
    Next
    wb.Close False
    sFile = Dir()
  Loop
  Application.ScreenUpdating = True
End Sub
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
The code works for me.
You will have to go back to the previous version where you write the path in the code.
 

Watch MrExcel Video

Forum statistics

Threads
1,112,863
Messages
5,542,941
Members
410,577
Latest member
ZvK
Top