VBA文件及文件夹操作Word下载.docx
《VBA文件及文件夹操作Word下载.docx》由会员分享，可在线阅读，更多相关《VBA文件及文件夹操作Word下载.docx（47页珍藏版）》请在冰豆网上搜索。
\folder1\a.xls"
as"
\folder1\d.xls"
E,判断文件及文件夹是否存在
Setyyy=CreateObject（"
Ifyyy.FolderExists（"
\folder1）=TrueThen...
Ifyyy.FileExists（"
\folder1\d.xls）=TrueThen...
.
F,打开folder1中所有文件
Setrrr=CreateObject（"
Setr=rrr.GetFolder（"
ForEachiInr.Files
Workbooks.OpenFilename：
=（"
\folder1\"
+i.Name+"
"
Next
G,删除文件c.xls
kill"
d：
H,删除文件夹folder
Setaaa=CreateObject（"
aaa.DeleteFolder"
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）'
每一行第一列填写一个文件名
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\"
choosethe
folderlocationforsave
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）>
=BeforeDateThenIfoMailItem.SenderName=SenderThen
IfoMailItem.Attachments.Count>
0Then'
protecterrorFori=1TooMailItem.Attachments.Count
IfoMailItem.Attachments.Item（i）.FileName=SendFileThenMyT1=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
Else
MyY=MyY+1
IfMyY>
10ThenGoToLoopEnd
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"
ThenKill（Stpath）
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（"
LinkFile=DirLoc&
CurFile
TableName=Left（CurFile,Len（CurFile）-4）
IfCurFile="
HONHAI-VMIData1.xls"
Then
WithobjAccess
.OpenCurrentDatabase（ThisWorkbook.Path&
.DoCmd.TransferSpreadsheetacLink,8,TableName,LinkFile,True,"
AgingReport$"
objAccess.CloseCurrentDatabase
SetobjAccess=Nothing
CurFile=Dir
.DoCmd.TransferSpreadsheetacImport,8,TableName,LinkFile,True,"
Loop
方法二
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
义一个文件搜索对象Sets=Application.FileSearch
\CustomersDataBase\Test\"
注'
意路径，换成你实际的路径
FullName1=Right（s.FoundFiles（i）,Len（s.FoundFiles（i））-Len（"
））
Filename=Left（FullName1,Len（FullName1）-4）
myFile="
Filename&
.OpenCurrentDatabase（"
.DoCmd.TransferSpreadsheetacImport,8,"
DSEM-MovingPlan"
myFile,True,"
4.vba操作文件及文件夹示例
2009-08-2000：
07
vba操作文件及文件夹示例
利用excel中的vba可以对电脑中的文件及文件夹做一些常用的操作。
包括复制、重命名、删除等，其中一些简单的示例总结如下。
希望对一些经常需要批量处理文件的朋友有所帮助，也希望感兴趣的朋
友多多指教！
以下代码建议在onerrorresumenext下测试
1，在D：
2，新建2个文件命名为a.xls和b.xls
3,创建新文件夹folder1并把a.xls复制到新文件夹重新命名为c.xls
4,复制folder中所有文件到folder1
5,重命名a.xls为d.xls
6,判断文件及文件夹是否存在
7,打开folder1中所有文件
Next8,删除文件c.xls
9,删除文件夹folder
VBADir函数遍历文件夹下的所有文件
2010-05-2617：
30
5.VBADir函数
第1.12例Dir函数一、题目：
要求编写一段代码，运用Dir函数返回一个文件夹的文件列表。
二、代码：
Sub示例_1_12（）
Dimwjm
wjm=Dir（"
\WINDOWS\WIN.ini"
MsgBoxwjm
\WINDOWS\*.ini"
wjm=Dir
三、代码详解
1、Sub示例_1_12（）：
宏程序的开始语句。
宏名为示例_1_12。
2、Dimwjm：
变量wjm声明为可变型数据类型。
3、wjm=Dir（"
）：
如果该文件存在则返回“WIN.INI”（在C：
\Windows文件夹中），把返
回的文件名赋给变量wjm。
如果该文件不存在则wjm=””。
4、wjm=Dir（"
返回带指定扩展名的文件名。
如果超过一个*.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
SublistPath（strDirAsString）
DimthePathAsString
DimstrSdirAsString
DimtheDirsAsScripting.Folders
DimtheDirAsScripting.Folder
DimrowAsInteger
DimsAsString
DimmyFsoAsScripting.FileSystemObjectSetmyFso=NewScripting.FileSystemObjectIfRight（strDir,1）<
ThenstrDir=strDir&
thePath=thePath&
strDir
row=pt.row'
此段为获取此目录下的文件名
s=Dir（the
升级会员 