Question

下面是循环遍历每个子文件夹中的所有excel工作簿（循环子文件夹）并从每个excel工作簿复制数据并附加到另一个excel工作簿的代码。超出以下代码我收到错误，因为＆＃34;对象不支持此属性或方法：＆＃39; objsubfolder.files＆＃39;＆＃34;请帮帮我。

'Sub RunCodeOnAllXLSFiles()

Set objExcel = CreateObject("Excel.Application")

strPath = "C:\Documents and Settings\SupriyaS\Desktop\su"
pathName="xlsx"

if strPath = "" then Wscript.quit
if pathName = "" then Wscript.quit

'Creating an Excel Workbook in My Documents
Set objWorkbook2= objExcel.Workbooks.Add()

objExcel.Visible = True
objExcel.DisplayAlerts = False

Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFso.GetFolder (strPath)
Set objsubFolder = objfolder.subFolders
set objfile = objsubfolder.files

for each objsubfoleder in objfolder.subfolders

For Each objFile In objsubFolders.Files

If objFso.GetExtensionName (objFile.Path) = "xlsx" Then
Set objWorkbook = objExcel.Workbooks.Open(objFile.Path)

Set objWorksheet = objWorkbook.WorkSheets(1)
objworksheet.Activate

' Select the range on Sheet1 you want to copy 
objWorkbook.Worksheets("SHEET1").usedrange.Copy

objworkbook.close

Set objRange = objExcel.Range("A1")
intNewRow = objExcel.ActiveCell.Row + 3
strNewCell = "A" &  intNewRow
objExcel.Range(strNewCell).Activate

' Paste it on sheet1 of workbook2, starting at A1
objWorkbook2.Worksheets("Sheet1").Range(strNewCell).PasteSpecial

Set objWorksheet = objWorkbook2.Worksheets(1)

End If
next
next

Answer 1

发布答案只是为了能够说：

USE选项明确

（并在首次使用前立即对所有变量进行Dim和初始化）

避免像＃34; objsubfoleder＆＃34;

这样的拼写错误

从许多子文件夹中的所有（许多）excel工作簿中复制数据，并将其复制到另一个excel工作簿

1 个答案: