簡體   English   中英

從許多子文件夾中的所有(許多)Excel工作簿中復制數據,並將其復制到另一個Excel工作簿中

[英]To copy the data from all (many) the excel workbook inside many subfolders and copy it to another excel workbook

下面的代碼循環遍歷每個子文件夾中的所有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

發表為答案只是為了能夠說:

明確使用選項

(然后在第一次使用之前(立即)調暗並初始化所有變量)

避免被“ objsubfoleder”之類的錯別字咬傷

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM