VBA文件及文件夹操作.docx
- 文档编号:30284592
- 上传时间:2023-08-13
- 格式:DOCX
- 页数:31
- 大小:27.65KB
VBA文件及文件夹操作.docx
《VBA文件及文件夹操作.docx》由会员分享,可在线阅读,更多相关《VBA文件及文件夹操作.docx(31页珍藏版)》请在冰豆网上搜索。
VBA文件及文件夹操作
VBA文件及文件夹操作
1.VBA操作文件及文件夹
onerrorresumenext下测试
A,在D:
\下新建文件夹,命名为folder
方法1:
MkDir”D:
\folder"
方法2:
Setabc=CreateObject("Scripting。
FileSystemObject")
abc。
CreateFolder("D:
\folder”)
B,新建2个文件命名为a.xls和b。
xls
Workbooks。
Add
ActiveWorkbook。
SaveAsFilename:
="D:
\folder\a.xls"
ActiveWorkbook.SaveAsFilename:
=”D:
\folder\b.xls"
C,创建新文件夹folder1并把a。
xls复制到新文件夹重新命名为c。
xls
MkDir"D:
\folder1"
FileCopy”D:
\folder\a.xls","D:
\folder1\c.xls”
D,复制folder中所有文件到folder1
Setqqq=CreateObject(”Scripting.FileSystemObject”)
qqq。
CopyFolder"D:
\folder”,"D:
\folder1"
D,重命名a.xls为d.xls
name"d:
\folder1\a。
xls”as”d:
\folder1\d。
xls”
E,判断文件及文件夹是否存在
Setyyy=CreateObject(”Scripting。
FileSystemObject”)
Ifyyy。
FolderExists(”D:
\folder1)=TrueThen。
.。
Ifyyy。
FileExists("D:
\folder1\d.xls)=TrueThen。
..
F,打开folder1中所有文件
Setrrr=CreateObject(”Scripting.FileSystemObject”)
Setr=rrr。
GetFolder("d:
\folder1”)
ForEachiInr.Files
Workbooks.OpenFilename:
=(”d:
\folder1\"+i.Name+"")
Next
G,删除文件c。
xls
kill”d:
\folder1\c.xls"
H,删除文件夹folder
Setaaa=CreateObject(”Scripting.FileSystemObject”)
aaa.DeleteFolder”d:
\folder”
2.8excelvba一次性获取文件夹下的所有文件名的方法
小生今天上网下载了一个财务常用报表的文件包,里面有几百个excel工作表,要是手工一个一个的获得文件名的话,那我可是要忙十天半月哦。
于是想到昨论坛就是vba论坛,昨不充分利用excel自身的高级应用呀,呵呵,实现的代码如下,把工作量几天的任务可是一下子就完成了,这就是excelvba给你工作提高效率的结果!
exclevba自动获取同一文件夹下所有工作表的名称红色代码:
按Alt+F11,打开VBA编辑器,插入一个模块,把下面的代码贴进去,按F5执行
Subt()
DimsAsFileSearch’定义一个文件搜索对象
Sets=Application.FileSearch
s.LookIn="c:
\”'注意路径,换成你实际的路径
s。
Filename="*.*"'搜索所有文件
s.Execute'执行搜索
Cells。
Delete'表格清空
Fori=1Tos。
FoundFiles。
Count
Cells(i,1)=s.FoundFiles(i)'每一行第一列填写一个文件名
Next
EndSub
现在获得的可是带路径的工作表名,去掉前的路径可用以下方法;
=RIGHT(A1,LEN(A1)—FIND(”#",SUBSTITUTE(A1,”\”,”#",LEN(A1)—LEN(SUBSTITUTE(A1,”\”,)))))
最后用常规的方法往下拖,就完成了笔者所需的工作表名。
outlook下VBA编程:
把公用文件夹里的邮件附件拷贝出来保存在硬盘上
2009-06—1709:
35
SubSaveAttachments()
DimoAppAsOutlook.Application
DimoNameSpaceAsNameSpace
DimoFolderAsMAPIFolder
DimoMailItemAsObject
DimsMessageAsString
BeforeDate=#10/1/2007#'choosetheenddateofwanted
MyDir="E:
\liuxc-work\oilloss\backupfrompublicfolder\"'choosethefolderlocationforsave
Sender=”Hz121Supervisor”'caution,casesensitive
SendFile=”HZ121-1_Daily。
xls"
MyY=0
SetoApp=NewOutlook.Application
SetoNameSpace=oApp.GetNamespace("MAPI")
SetoFolder=oNameSpace。
PickFolder
ForEachoMailItemInoFolder.Items
WithoMailItem
MyT3=Left(CStr(oMailItem.CreationTime),10)
IfCDate(oMailItem。
CreationTime)>=BeforeDateThen
IfoMailItem。
SenderName=SenderThen
IfoMailItem.Attachments。
Count>0Then'protecterror
Fori=1TooMailItem.Attachments.Count
IfoMailItem。
Attachments.Item(i).FileName=SendFileThen
MyT1=InStr(1,oMailItem。
Attachments。
Item(i).FileName,”。
”,1)
MyT2=Left(oMailItem。
Attachments。
Item(i).FileName,19)+"-”+MyT3+"。
xls"
oMailItem.Attachments.Item(i).SaveAsFileMyDir&MyT2
MsgBoxoMailItem.Attachments。
Item(i)。
DisplayName&”wassavedas”&oMailItem.Attachments。
Item(i)。
FileName
EndIf
Nexti
EndIf
EndIf
Else
MyY=MyY+1
IfMyY〉10ThenGoToLoopEnd
EndIf
EndWith
NextoMailItem
LoopEnd:
'SetoMailItem=Nothing
’SetoFolder=Nothing
’SetoNameSpace=Nothing
'SetoApp=Nothing
3.ExcelVBA把选定文件夹中的工作簿导入到新建ACCESS数据库中
2010-04-2422:
33
方法一
SubCreate_AccessProject()
DimAccessDataAsObject
SetAccessData=CreateObject("Access.Application")
DimStpathAsString
Stpath=ThisWorkbook。
Path&”\DSEM-Stock-Allocation.mdb”’设定路径
IfDir(Stpath,vbDirectory)=”DSEM-Stock—Allocation。
mdb"Then
Kill(Stpath)
EndIf
AccessData。
NewCurrentDatabaseStpath
SetAccessData=Nothing'创建表格
Setcnnaccess=CreateObject(”Adodb。
Connection")
SetrstAnswers=CreateObject("Adodb.Recordset”)
cnnaccess。
Provider=”Microsoft。
Jet。
OLEDB。
4。
0"
Application。
WaitNow()+TimeValue("00:
00:
02")’系统暂停2秒,以等待data.mdb建立成功
cnnaccess。
Open"DataSource="&Stpath&”;JetOLEDB:
DatabasePassword="&”"
'strSQL=”CreateTablemyData(last_datechar(8))”
’rstAnswers.OpenstrSQL,cnnaccess
SetrstAnswers=Nothing
Setcnnaccess=Nothing
MyMainFile=ThisWorkbook。
Name
DimCurFileAsString
Application。
DisplayAlerts=False
myFile=Application。
GetOpenFilename(”(*.xls),*。
xls)",,"PleaseSelectFiles")
IfmyFile=FalseThenExitSub
DirLoc=CurDir(myFile)&"\”
CurFile=Dir(DirLoc&”*.xls")
DoWhileCurFile<>vbNullString
SetobjAccess=CreateObject("Access。
Application")
LinkFile=DirLoc&CurFile
TableName=Left(CurFile,Len(CurFile)-4)
IfCurFile="HONHAI-VMIData1。
xls”Then
WithobjAccess
.OpenCurrentDatabase(ThisWorkbook。
Path&”\DSEM-Stock-Allocation.mdb”)
.DoCmd。
TransferSpreadsheetacLink,8,TableName,LinkFile,True,”AgingReport$”
EndWith
objAccess。
CloseCurrentDatabase
SetobjAccess=Nothing
CurFile=Dir
Else
WithobjAccess
。
OpenCurrentDatabase(ThisWorkbook.Path&"\DSEM—Stock—Allocation.mdb")
.DoCmd.TransferSpreadsheetacImport,8,TableName,LinkFile,True,”"
EndWith
objAccess.CloseCurrentDatabase
SetobjAccess=Nothing
CurFile=Dir
EndIf
Loop
EndSub
方法二
SubFolder2Access()
DimdbAsDAO。
Database
DimwsAsDAO.Workspace
Setws=DBEngine。
Workspaces(0)
Setdb=ws.OpenDatabase(”C:
\CustomersDataBase\DSEM—PO-Stock—Status.mdb”,False,False,”")
db。
Execute(”delete*from[DSEM-MovingPlan]”)
db.Close
Setdb=Nothing
DimmyFileAsString
DimsAsFileSearch’定义一个文件搜索对象
Sets=Application。
FileSearch
s。
LookIn=”C:
\CustomersDataBase\Test\"'注意路径,换成你实际的路径
s。
Filename="*.*"’搜索所有文件
s.Execute'执行搜索
Fori=1Tos.FoundFiles。
Count
FullName1=Right(s.FoundFiles(i),Len(s.FoundFiles(i))—Len(”C:
\CustomersDataBase\Test\"))
Filename=Left(FullName1,Len(FullName1)—4)
SetobjAccess=CreateObject("Access。
Application”)
myFile="C:
\CustomersDataBase\Test\"&Filename&"。
xls”
WithobjAccess
.OpenCurrentDatabase("C:
\CustomersDataBase\DSEM-PO—Stock-Status.mdb")
.DoCmd。
TransferSpreadsheetacImport,8,”DSEM-MovingPlan",myFile,True,””
EndWith
objAccess.CloseCurrentDatabase
SetobjAccess=Nothing
Next
EndSub
4.vba操作文件及文件夹示例
2009-08—2000:
07
vba操作文件及文件夹示例
利用excel中的vba可以对电脑中的文件及文件夹做一些常用的操作.
包括复制、重命名、删除等,其中一些简单的示例总结如下.
希望对一些经常需要批量处理文件的朋友有所帮助,也希望感兴趣的朋友多多指教!
以下代码建议在onerrorresumenext下测试
1,在D:
\下新建文件夹,命名为folder
方法1:
MkDir”D:
\folder"
方法2:
Setabc=CreateObject(”Scripting.FileSystemObject”)
abc.CreateFolder(”D:
\folder”)
2,新建2个文件命名为a。
xls和b。
xls
Workbooks。
Add
ActiveWorkbook。
SaveAsFilename:
="D:
\folder\a。
xls"
ActiveWorkbook.SaveAsFilename:
="D:
\folder\b.xls"
3,创建新文件夹folder1并把a。
xls复制到新文件夹重新命名为c.xls
MkDir"D:
\folder1"
FileCopy”D:
\folder\a.xls”,"D:
\folder1\c。
xls”
4,复制folder中所有文件到folder1
Setqqq=CreateObject("Scripting。
FileSystemObject”)
qqq.CopyFolder"D:
\folder”,"D:
\folder1"
5,重命名a.xls为d.xls
name"d:
\folder1\a.xls”as”d:
\folder1\d。
xls"
6,判断文件及文件夹是否存在
Setyyy=CreateObject(”Scripting。
FileSystemObject”)
Ifyyy。
FolderExists("D:
\folder1)=TrueThen。
。
.
Ifyyy.FileExists("D:
\folder1\d。
xls)=TrueThen。
..
7,打开folder1中所有文件
Setrrr=CreateObject("Scripting。
FileSystemObject”)
Setr=rrr.GetFolder(”d:
\folder1”)
ForEachiInr.Files
Workbooks.OpenFilename:
=("d:
\folder1\”+i。
Name+"")
Next8,删除文件c.xls
kill"d:
\folder1\c.xls”9,删除文件夹folder
Setaaa=CreateObject("Scripting。
FileSystemObject")
aaa。
DeleteFolder”d:
\folder”
VBADir函数遍历文件夹下的所有文件
2010-05—2617:
30
5.VBADir函数
第1.12例Dir函数
一、题目:
要求编写一段代码,运用Dir函数返回一个文件夹的文件列表.
二、代码:
Sub示例_1_12()
Dimwjm
wjm=Dir("C:
\WINDOWS\WIN。
ini”)
MsgBoxwjm
wjm=Dir(”C:
\WINDOWS\*。
ini”)
wjm=Dir
EndSub
三、代码详解
1、Sub示例_1_12():
宏程序的开始语句。
宏名为示例_1_12.
2、Dimwjm:
变量wjm声明为可变型数据类型。
3、wjm=Dir(”C:
\WINDOWS\WIN。
ini”):
如果该文件存在则返回“WIN.INI”(在C:
\Windows文件夹中),把返回的文件名赋给变量wjm。
如果该文件不存在则wjm=”"。
4、wjm=Dir("C:
\WINDOWS\*.ini"):
返回带指定扩展名的文件名.如果超过一个*.ini文件存在,函数将返回按条件第一个找到的文件名。
5、wjm=Dir:
若第二次调用Dir函数,但不带任何参数,则函数将返回同一目录下的下一个*.ini文件。
Dir函数
返回一个字符串String,用以表示一个文件名、目录名或文件夹名称,它必须与指定的模式或文件属性、或磁盘卷标相匹配.
Dir[(pathname[,attributes])]
Dir函数的语法具有以下几个部分:
pathname可选参数。
用来指定文件名的字符串表达式,可能包含目录或文件夹、以及驱动器。
如果没有找到pathname,则会返回零长度字符串("")。
attributes可选参数。
常数或数值表达式,其总和用来指定文件属性。
如果省略,则会返回匹配pathname但不包含属性的文件。
EXCEL的VBA用于同时显示目录文件夹和文件列表
2010—05—2218:
41
”VBA工具中要引用microsoftsciptingruntime
DimptAsRange
Sub查找文件夹下子文件夹及其大小()
DimtheDirAsString
Setpt=ActiveSheet。
Range("a1”)
pt。
Worksheet。
Columns
(1)。
ClearContents'清除第一列
theDir=Application。
InputBox(”输入指定文件夹的路径:
”,"查看子文件夹及其大小")
pt=theDir‘列出选取的目录名
listPaththeDir’用于列出子目录和文件
pt.Worksheet。
Columns("a:
b”).AutoFit
EndSub
SublistPath(strDirAsString)
DimthePathAsString
DimstrSdirAsString
DimtheDirsAsScripting.Folders
DimtheDirAsScripting。
Folder
DimrowAsInteger
DimsAsString
DimmyFsoAsScripting。
FileSystemObject
SetmyFso=NewScripting.FileSystemObject
IfRight(strDir,1)<>”\”ThenstrDir=strDir&”\"
thePath=thePath&strDir
row=pt.row’此段为获取此目录下的文件名
s=Dir(thePath,7)’获取第一个文件
DoWhiles〈>""
row=row+1
Cells(row,1)=s’文件的名称
Cells(row,1)。
Font。
Color=RGB(256,12,213)
Cells(row,1)。
Font。
Bold=Ture
s=Dir‘下一个文件
Loop
Setpt=Cells(row,1)
Setpt=pt.Offset(1,0)
SettheDirs=myFso.getfolder(strDir)。
subfolders
ForEachtheDirIntheDirs
pt=theDir。
Path
pt.Next=theDir.Size
listPaththeDir.Path
Next
SetmyFso=Nothing
EndSub
PrivateSubCommandButton1_Click()
查找文件夹下子文件夹及其大小
EndSub
6.用VBA获取文件夹中的文件列表
如果我们要在Excel中获取某个文件夹中所有的文件列表,可以通过下面的VBA代码来进行.代码运行后,首先弹出一个浏览文件夹对话框,然后新建一个工作簿,并在工作表的A至F列分别列出选定文件夹中的所有文件的文件名、文件大小、创建时间、修改时间、访问时间及完整路径。
方法如下:
1。
按Alt+F11,打开VBA编辑器,单击菜单“插入→模块",将下面的代码粘贴到右侧的代码窗口中:
OptionExplicit
SubGetFileList()
DimstrFolderAsString
DimvarFileListAsVariant
DimFSOAsObject,myFileAsObject
DimmyResultsAsVariant
DimlAsLong
'显示打开文件夹对话框
WithApplication。
FileDialog(msoFileDialogFolderPicker)
.Show
If.SelectedItems。
Count=0ThenExitSub’未选择文件夹
strFolder=.Selecte
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- VBA 文件 文件夹 操作