下面是循环遍历每个子文件夹中的所有excel工作簿(循环子文件夹)并从每个excel工作簿复制数据并附加到另一个excel工作簿的代码 . 超出下面的代码我得到一个错误,因为“对象不支持这个属性或方法:'objsubfolder.files'”请帮助我 .
'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
1 回答
作为答案发表只是为了能够说:
USE Option Explicit
(并在首次使用前立即对所有变量进行Dim和初始化)
避免像“objsubfoleder”这样的拼写错误