简体   繁体   中英

Excel macro run time 1004 document may be read-only

I was attempting to extract data from other workbooks into a master workbook. All of these workbooks were saved in one folder. Besides, before extracting the data it would check the number of files in the folder. If there is only one file and it is the master workbook then it will stop and exit sub.

However, when I ran the macro it got stuck in the "Do while" loop. Then it says it has a run time error 1004, document may be read-only or encrypted1.

I am sure the path is correct.

Below is my code.

 Sub LoopThroughDirectory()
   Dim MyFile As String
   Dim erow
   Dim Filepath As String
   Filepath = "C:\Users\uidq3022\Desktop\Backup_Version2.0_7_12\"
   MyFile = Dir(Filepath)

   Do While Len(MyFile) > 0
     If MyFile = "Import Info.xlsm" Then
       Exit Sub
     End If

     Workbooks.Open (Filepath & MyFile)
     Range("F9,F12,F15,F19,F21").Select
     Range("F21").Activate

     ActiveWindow.SmallScroll Down:=9
     Range("F9,F12,F15,F19,F21,F27,F30,F33,F37").Select
     Range("F37").Activate

     ActiveWindow.SmallScroll Down:=9
     Range("F9,F12,F15,F19,F21,F27,F30,F33,F37,F41").Select
     Range("F41").Activate

     ActiveWindow.SmallScroll Down:=-27
     Range("F9,F12,F15,F19,F21,F27,F30,F33,F37,F41,F6").Select
     Range("F6").Activate
     Selection.Copy
     ActiveWorkbook.Close

     erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
     ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 11))
     MyFile = Dir
   Loop
 End Sub

And my questions are,

  1. I don't know where I went wrong with the "Do while" loop
  2. How to fix the run time 1004 error.

Can someone give me advise? Thanks a lot!

Seems to me you're using the loop to open the files instead of doing it manually yourself. Not sure why the loop got stuck unless you had the MyFile = Dir line missing or commented out at runtime.

@Thomas is mostly right, the 1004 error is happening because the source workbook is being closed too early. However, I was able to paste the values using wkbTarget.worksheets(1).paste but it pasted all cells between F6 through F41 - not what you want.

Additionally, your copy range is 11 rows, 1 column but you're specifying a destination range of 1 row, 11 columns: Cells(erow, 1), Cells(erow, 11) . If that's what you really want, you should use Transpose . Using Cells(#,#) inside Range() also produced 1004 errors, but Cells(#,#).address resolved it.

Here's my take:

Sub LoopThroughDirectory()
  Dim MyFile As String
  Dim wkbSource as Workbook
  Dim wkbTarget as Workbook
  Dim erow as single
  Dim Filepath As String

  Filepath = "C:\Users\uidq3022\Desktop\Backup_Version2.0_7_12\"
  MyFile = Dir(Filepath)

  Set wkbTarget = Workbooks(MyFile)                    'Assuming the file is already open

  Do While Len(MyFile) > 0
  If MyFile = "Import Info.xlsm" Then Goto NextFile    'Skip the file instead of exit the Sub

  Set wkbSource = Workbooks.Open (Filepath & MyFile)   'Set a reference to the file being opened
  wkbSource.worksheet(1).Range("F9,F12,F15,F19,F21,F27,F30,F33,F37,F41,F6").Select
  Selection.Copy

  erow = wkbTarget.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
  wkbTarget.Worksheets("Sheet1").Paste Destination:=wkbTarget.Worksheets("Sheet1").Range(Cells(erow, 1).address)

  wkbSource.Close

NextFile:
  MyFile = Dir

  Loop
  End Sub

Thomas's single-line copy+paste technique is nicely concise. You could rearrange the lines of code to use that approach, I just recommend making the Source and Target objects clear.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM