VBA開啟文件夾下所有文件

本文格式為Word版，下載可任意編輯——VBA開啟文件夾下所有文件

‘subxlsOpen()

Setrrr=CreateObject(\Setr=rrr.GetFolder(\練習(xí)\\\

Application.ScreenUpdating=FalseForEachiInr.Files

Workbooks.OpenFilename:=(\練習(xí)\\\Sheets(1).Cells(2,5)=“10〞

ActiveWorkbook.Closesavechanges:=trueNext

Application.ScreenUpdating=True‘EndSubExecuteExcel4Macro\‘打印當(dāng)前SHEET

ActiveWorkbook.Closesavechanges:=false‘不保存關(guān)閉ActiveWorkbook.Closesavechanges:=true‘保存關(guān)閉setrrr=CreateObject(\‘subSHEET,range

Setr=rrr.GetFolder(\練習(xí)\Application.ScreenUpdating=FalseForEachiInr.Files

Workbooks.OpenFilename:=(\練習(xí)\\\‘+=&Sheets(1).SelectRange(\

ActiveCell.FormulaR1C1=\

ActiveWorkbook.Closesavechanges:=true

Next

Application.ScreenUpdating=True‘EndSub

Dimwjm‘Subdir用法

wjm=Dir(\練習(xí)\\*.xls\MsgBoxwjm

DoWhilewjm\當(dāng)指定路徑中有文件時(shí)進(jìn)行循環(huán)MsgBoxwjm

wjm=Dir:'找尋下一個(gè)*.xls文件Loop‘EndSubdir用法

DimMyPath$,MyName$,shAsWorksheet,arr‘SUB能用原版Setsh=ActiveSheet

MyPath=ThisWorkbook.Path&\

MyName=Dir(MyPath&\Application.ScreenUpdating=False

[a1].CurrentRegion.Offset(2).ClearContentsDoWhileMyName\

IfMyNameThisWorkbook.NameThenWithGetObject(MyPath&MyName).CloseFalseEndWithEndIf

MyName=DirLoop

Application.ScreenUpdating=True

MsgBox\‘endsub能用原版

DimMyPath$,MyName$,shAsWorksheet,arr‘sub能用改版

MyPath=(\練習(xí)\\\‘MyPath=ThisWorkbook.Path&\MyName=Dir(MyPath&\Application.ScreenUpdating=False

DoWhileMyName\‘IfMyNameThisWorkbook.NameThen

WithGetObject(MyPath&MyName)‘Workbooks.Open(MyPath&MyName).Sheets(1).Cells(2,7)=MyPath&MyName‘Sheets(1).Cells(2,7)=“1”Windows(MyName).Visible=True

.Closesavechanges:=True‘ActiveWorkbook.Closesavechanges:=trueEndWithEndIf

MyName=DirLoop

Application.ScreenUpdating=TrueMsgBox\‘EndSub能用改版

DimMyPath$,MyName$,shAsWorksheet,aasInteger‘sub寫入所有文件全名MyPath=(\練習(xí)\\\‘MyPath=ThisWorkbook.Path&\MyName=Dir(MyPath&\Application.ScreenUpdating=Falsea=1

DoWhileMyName\IfMyNameThisWorkbook.NameThen

WithGetObject(MyPath&MyName)‘Workbooks.Open(MyPath&MyName).Sheets(1).Cells(2,7)=MyPath&MyName‘Sheets(1).Cells(2,7)=“1”ActiveWorkbook.Sheets(1).Cells(a,1)=MyPath&MyNameWindows(MyName).Visible=True

.Closesavechanges:=True‘ActiveWorkbook.Closesavechanges:=trueEndWitha=a+1EndIf

MyName=DirLoop

Application.ScreenUpdating=True

MsgBox\’EndSub寫入所有文件全名

DimMypathAsString‘SUB寫入到A:ADimMynameAsString

Dimarr(1To1000,1To1)AsStringDimkAsInteger

Mypath=(\練習(xí)\\\Myname=dir(Mypath&\DoWhileMyname\k=k+1

arr(k,1)=Myname

Myname=dirLoop

Columns(\

Cells(1,1).Resize(UBound(arr),1)=arrMsgBox\‘ENDSUB寫入到A:A

SubWorkbooks(\‘Windows(\‘Endsub

subActiveWindow.Visible=FalseWorkbooks(\（1）.Visible=False‘Endsub

DimMyFile,MyPath,MyName‘subdir

'返回“WIN.INI〞（假使該文件存在）。

MyFile=Dir(\練習(xí)\\1.xls\

'返回帶指定擴(kuò)展名的文件名。假使超過一個(gè)*.ini文件存在，'函數(shù)將返回按條件第一個(gè)找到的文件名。MyFile=Dir(\練習(xí)\\*.xls\

'若其次次調(diào)用Dir函數(shù)，但不帶任何參數(shù)，則函數(shù)將返回同一目錄下的下一個(gè)*.ini文件。MyFile=Dir

'返回找到的第一個(gè)隱式*.TXT文件。

MyFile=Dir(\‘endsubsubdir

MyPath=\練習(xí)\\\'sub指定路徑。

MyName=Dir(MyPath,vbDirectory)'找尋第一項(xiàng)。DoWhileMyName\開始循環(huán)。'跳過當(dāng)前的目錄及上層目錄。

IfMyName\'使用位比較來(lái)確定MyName代表一目錄。

If(GetAttr(MyPath&MyName)AndvbDirectory)=vbDirectoryThenDebug.PrintMyName'假使它是一個(gè)目錄，將其名稱顯示出來(lái)。EndIfEndIf

MyName=Dir'查找下一個(gè)目錄。

Loop

DimaAsString‘subA列全名B列本名

Dimb(1000)AsString‘1000為允許的I的數(shù)量Dimc(1000)AsStringDimi,jAsIntegeri=0

a=dir(\練習(xí)\\*.*\Doc(i)=a

b(i)=\練習(xí)\\\Cells(i+1,2)=c(i)'2列Cells(i+1,1)=b(i)'1列i=i+1

a=dir'()'A走下一個(gè)LoopUntila=\

MsgBox\‘endsubsubA列全名B列本名

DimfnAsString‘subwhile全名寫入A列DimrAsLong

fn=Dir(\D:\\EXCEL練習(xí)\\*.xls\R=0

Whilefn\r=r+1Cells(r,1)=fnfn=Dir()Wend

MsgBox\‘endsubwhile全名寫入A列

DimMypathAsString'sub文件夾下一極所有找文件夾

DimMyfileAsString

Dimarr(1To1000,1To1)AsString

DimkAsInteger

Mypath=\練習(xí)\\\Myfile=dir(Mypath,vbDirectory)

DoWhileMyfile\

IfGetAttr(Mypath&Myfile)=vbDirectoryThen

k=k+1arr(k,1)=Myfile

EndIfMyfile=dir

Loop

Columns(\

Cells(1,1).Resize(UBound(arr),1)=arr'endsub文件夾下一極所有找文件夾

Dimfs,fold,fls,fl‘Sub2023vba開啟子文件()Setfs=CreateObject(\Setfold=fs.getfolder(\練習(xí)\\\‘能用Setfls=fold.FilesForEachflInfls

IfInStr(fl.Name,\Workbooks.Openfl.Path'開啟文件Sheets(1).Cells(2,5)=\

Workbooks(fl.Name).CloseSavechanges:=True'關(guān)閉文件

EndIfNext

MsgBox\‘endsubSub2023vba開啟子文件()DimnmAsString‘sub開啟文件最簡(jiǎn)單代碼nm=dir(\練習(xí)\\\DoWhileLen(nm)0

Workbooks.Open(\練習(xí)\\\Sheets(1).Cells(2,5)=\Workbooks(nm).CloseSavechanges:=Truenm=dir()Loop

MsgBox\‘endsub打開文件最簡(jiǎn)潔代碼DimiAsLong‘SubfileSearchVBA2003能用DimfsAsObject

Setfs=Application.FileSearchWithfs

.LookIn=\D:\\EXCEL練習(xí)\'設(shè)置要查找的起始目錄

.FileType=msoFileTypeExcelWorkbooks'要查找的文件類型.SearchSubFolders=True'是否查找子目錄.Execute'根據(jù)上面的設(shè)置執(zhí)行查找Fori=1To.FoundFiles.Count

Workbooks.Open.FoundFiles(i)'遍歷打開找到的EXCEL文件Nexti

EndWith‘EndSubfileSearchVBA2003能用

Dimp,f,sh‘sub打印所有本子

p=ThisWorkbook.Path&\'提取當(dāng)前工作薄路徑f=Dir(p&\)'提取目錄指定文件類型為xlsDoWhilef\'假使文件F\IffThisWorkbook.NameThen'f當(dāng)前工作薄名Workbooks.Open(p&f)'打開f

ForEachshInActiveWorkbook.Sheets'循環(huán)所有工作表

sh.PrintOut'打印工作表Nextsh

Workbooks(f).CloseFalse'閉卷當(dāng)前f工作薄,false=不保存EndIf

f=Dir'提取一下文件名Loop

ForEachshInThisWorkbook.Sheets'循環(huán)完以后開始打印當(dāng)前工作薄sh.PrintOut

Nextsh‘EndSub打印所有本子

SubMacro1()‘未試驗(yàn)不知實(shí)用性

DimmyDialogAsFileDialog,oFileAsObject,strNameAsString,nAsIntegerDimFSOAsObject,myFolderAsObject,myFilesAsObject,Dimfn$SetmyDialog=Application.FileDialog(msoFileDialogFolderPicker)n=1

WithmyDialog

If.Show-1ThenExitSub

SetFSO=CreateObject(\這是文件夾選擇,點(diǎn)選到你存放文件的那個(gè)SetmyFolder=FSO.GetFolder(.InitialFileName)SetmyFiles=myFolder.Files

ForEachoFileInmyFiles

strName=UCase(oFile.Name)strName=VBA.Right(strName,3)IfstrName=\這是擴(kuò)展名選擇'下面就可接著寫打開文件讀取數(shù)據(jù)再寫入的語(yǔ)句了,如下:fn=myFolder&\Workbooks.OpenFilename:=fn

Worksheets(1).Select'假設(shè)你讀取SHEET1的數(shù)據(jù)

RANGE_=Range(\需要數(shù)據(jù)的區(qū)域,自己修改

Windows(\外部表格數(shù)據(jù)自動(dòng)導(dǎo)入.xls\這個(gè)是新表的文件名,自己修改下Worksheets(n).Select'打開第幾個(gè)文件就選擇SHEET幾,如果沒有可用ADD代碼添加Range(\寫入數(shù)據(jù)Workbooks(2).Closen=n+1EndIfNext

EndWith‘EndSub未實(shí)驗(yàn)不知實(shí)用性

DimMypathAsString'sub輸出文件夾下一極所有找文件夾名，打開本級(jí)和下級(jí)所有文件DimMyfileAsStringDimnmAsString

Dimarr(1To1000,1To1)AsStringDimkAsInteger

Mypath=\練習(xí)\\\

Myfile=dir(Mypath,vbDirectory)

DoWhileMyfile\'開始循環(huán)。

IfGetAttr(Mypath&Myfile)=vbDirectoryThenk=k+1

arr(k,1)=Myfile

Setrrr=CreateObject(\Setr=rrr.GetFolder(Mypath&Myfile)

Application.ScreenUpdating=FalseForEachiInr.Files

Workbooks.Openfilename:=(Mypath&Myfile&\Sheets(1).Cells(2,5)=\ActiveWorkbook.Closesavechanges:=TrueNextEndIf

Myfile=dir'查找下一個(gè)目錄。

Loop

Columns(\

Cells(1,1).Resize(UBound(arr),1)=arr

MsgBox\‘endsub輸出文件夾下一極所有找文件夾名，開啟本級(jí)和下級(jí)所有文件

VB+Dir

函數(shù)遞歸列出目錄所有文件，包含子目錄

PrivateSubEnumDir(ByValpathnameAsString)

DimpathsAsCollection'保存當(dāng)前下的所有子目錄paths=NewCollection

IfRight$(pathname,1)\Thenpathname=pathname&\EndIf

DimfilenameAsString

filename=Dir(pathname,vbDirectory+vbSystem+vbHidden+vbReadOnly)DoWhilefilename\

Iffilename\Andfilename\Then'’跳過當(dāng)前目錄和上層目錄If(GetAttr(pathname&filename)AndvbDirectory)=vbDirectoryThenpaths.Add(pathname&filename)'假使是目錄，則將目錄名添加到目錄集合，為遞歸做準(zhǔn)備ElseList1.AddItem(filename)'將文件名添加到listboxEndIfEndIf

filename=Dir()Loop

DimiAsInteger

Fori=1Topaths.Count'遞歸子目錄EnumDir(paths(i))Next‘EndSub

返回一個(gè)String，用以表示一個(gè)文件名、目錄名或文件夾名稱，它必需與指定的模式或文件屬性、或磁盤卷標(biāo)相匹配。語(yǔ)法

Dir[(pathname[,attributes])]Dir函數(shù)的語(yǔ)法具有以下幾個(gè)部分：

部分描述

pathname

可選參數(shù)。用來(lái)指定文件名的字符串表達(dá)式，可能包含目錄或文件夾、以及驅(qū)動(dòng)器。假使沒有找到pathname，則會(huì)返回零長(zhǎng)度字符串(\。

可選參數(shù)。常數(shù)或數(shù)值表達(dá)式，其總和用來(lái)指定文件屬性。假使省略，則會(huì)返回匹配pathname但不包含屬性的文件。

attributes

設(shè)置值

attributes參數(shù)的設(shè)置可為：

常數(shù)vbNormalvbReadOnlyvbHiddenVbSystemvbVolume

值01248

描述

(缺省)指定沒有屬性的文件。指定無(wú)屬性的只讀文件指定無(wú)屬性的隱蔽文件

指定無(wú)屬性的系統(tǒng)文件在Macintosh中不可用。

指定卷標(biāo)文件；假使指定了其它屬性，則忽略vbVolume在Macintosh中不可用。

vbDirectoryvbAlias

1664

指定無(wú)屬性文件及其路徑和文件夾。指定的文件名是別名，只在Macintosh上可用。

注意這些常數(shù)是由VBA所指定的，在程序代碼中的任何位置，可以使用這些常數(shù)來(lái)替換真正的數(shù)值。說明

在MicrosoftWindows中，Dir支持多字符(*)和單字符(?)的通配符來(lái)指定多重文件。在Macintosh中，這些字符作為合法文件名字符并且不能作為通配符來(lái)指定多個(gè)文件為選中文件夾中所有文件，指定一空串:Dir(\

在MicrosoftWindows中，假使在Dir函數(shù)中使用MacID函數(shù)，將產(chǎn)生錯(cuò)誤。任何大于256的attribute值都被認(rèn)為是MacID函數(shù)的值。

在第一次調(diào)用Dir函數(shù)時(shí)，必需指定pathname，否則會(huì)產(chǎn)生錯(cuò)誤。假使也指定了文件屬性，那么就必需包括pathname。

Dir會(huì)返回匹配pathname的第一個(gè)文件名。若想得到其它匹配pathname的文件名，再一次調(diào)用Dir，且不要使用參數(shù)。假使已沒有貼合條件的文件，則Dir會(huì)返回一個(gè)零長(zhǎng)度字符串(\。一旦返回值為零長(zhǎng)度字符串，并要再次調(diào)用Dir時(shí)，就必需指定pathname，否則會(huì)產(chǎn)生錯(cuò)誤。不必訪問到所有匹配當(dāng)前pathname的文件名，就可以改變到一個(gè)新的pathname上。但是，不能以遞歸方式來(lái)調(diào)用Dir函數(shù)。以vbDirectory屬性來(lái)調(diào)用Dir不能連續(xù)地返回子目錄。提醒由于文件名并不會(huì)以特別的次序來(lái)返回，所以可以將文件名存儲(chǔ)在一個(gè)數(shù)組中，然后再對(duì)這個(gè)數(shù)組排序。

本例如使用Dir函數(shù)來(lái)檢查某些文件或目錄是否存在。在Macintosh計(jì)算機(jī)上，默認(rèn)驅(qū)動(dòng)器名稱是“HD〞，并且路徑部分由冒號(hào)取代反斜線隔開。而且MicrosoftWindows的通配符在Mac中可以作為有效字符出現(xiàn)在文件名中。也可以使用MacID函數(shù)來(lái)指定文件組。DimMyFile,MyPath,MyName

'返回“WIN.INI〞(在MicrosoftWindows中)（假使該文件存在）。MyFile=Dir(\

'返回帶指定擴(kuò)展名的文件名。假使超過一個(gè)*.ini文件存在，'函數(shù)將返回按條件第一個(gè)找到的文件名。MyFile=Dir(\

'若其次次調(diào)用Dir函數(shù)，但不帶任何參數(shù)，則函數(shù)將返回同一目錄下的下一個(gè)*.ini文件。MyFile=Dir

'返回找到的第一個(gè)隱式*.TXT文件。MyFile=Dir(\vbHidden)

'顯示C:\\目錄下的名稱。

MyPath=\指定路徑。

MyName=Dir(MyPath,vbDirectory)'找尋第一項(xiàng)。DoWhileMyName\開始循環(huán)。'跳過當(dāng)前的目錄及上層目錄。

IfMyName\'使用位比較來(lái)確定MyName代表一目錄。

If(GetAttr(MyPath&MyName)AndvbDirectory)=vbDirectoryThenDebug.PrintMyName'假使它是一個(gè)目錄，將其名稱顯示出來(lái)。EndIfEndIf

MyName=Dir'查找下一個(gè)目錄。Loop

aa=2c=3x=2

DoWhileNotIsEmpty(Sheets(\x=x+1Loop

yc=x‘找CKJL第一個(gè)空行

DoWhileNotIsEmpty(Sheets(\‘名稱a=Sheets(\‘?dāng)?shù)量f=2，d=Sheets(\‘型號(hào)e=Sheets(\‘型號(hào)d1=Sheets(\‘名稱f1=Sheets(\‘名稱

DoWhiledeOrd1f1f=f+1

d=Sheets(\e=Sheets(\d1=Sheets(\

f1=Sheets(\

Loop‘在ZB中找CKD（C，3）名稱一致項(xiàng)

IfSheets(\bb=Sheets(\

Ifbb>=0Then

Sheets(\

Sheets(\Sheets(\Sheets(\Sheets(\Sheets(\Sheets(\Sheets(\Sheets(\Sheets(\

Else:MsgBox\庫(kù)存量出錯(cuò)\

EndIf

EndIf

IfSheets(\

Sheets(\s(f,1)當(dāng)前名稱一致單元格

Sheets(\Sheets(\Sheets(\Sheets(\Sheets(\Sheets(\Sheets(\Sheets(\Sheets(\aa=aa+1EndIf