EXCEL宏保存文件至指定目录
自己写了一个保存文件的宏,代码如下:
Sub SaveFiles()
日期 = Format$(Date, "yymmdd")
年度 = Format$(Date, "yyyy")
月份 = Format$(Date, "mm")
Range("B1:AI50").Select
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:= _
"D:\员工组织图\" & 年度 & "年员工组织图\" & 月份 & "月\员工组织图" & 日期 & ".xls" _
, FileFormat:=xlExcel8, CreateBackup:=False
ActiveWindow.Close
End Sub
主要实现功能是:将文件另存在指定目录,目录结构是当前年度 =>月份,参考附图,并且文件以当前日期命名.
现在这个宏上述功能已经可以实现,只是出现一个问题,就是如何实现当目录文件夹不存在时自动创建目录,例如现在是10月份,文件应该是保存在[员工组织图]=>[2012年员工组织图]=>[10月].可现在10月这个文件夹没有,那么就需要宏来创建这个文件夹.
请教高手如何实现.
感谢!
if dir( "D:\员工组织图\" & 年度 & "年员工组织图\" & 月份 & "月", vbDirectory)="" then '文件夹不存在
mkdir "D:\员工组织图\" & 年度 & "年员工组织图\" & 月份 & "月" '建立文件夹
end if
-------------------------------------------
ActiveWorkbook.SaveAs Filename:= _
"D:\员工组织图\" & 年度 & "年员工组织图\" & 月份 & "月\员工组织图" & 日期 & ".xls" _
, FileFormat:=xlExcel8, CreateBackup:=False
---------------------------------------------------本回答被提问者和网友采纳
Application.ScreenUpdating = False
Sheets(1).Copy
ActiveWorkbook.SaveAs Filename:="D:\数据备份\" & Date & ".xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
ActiveWorkbook.Close
End Sub
楼主可以参考以下代码，修改一下加入你原先的代码便可。
Sub 判断文件夹是否存在无则新建()
Dim fso, f1
Set fso = CreateObject("scripting.filesystemobject")
If (fso.folderexists("d:\通知")) Then '如果存在这个文件夹
'这里继续放保存文件的代码
Else '如果不存在这个文件夹
Set f1 = fso.createfolder("d:\通知") '创建文件夹
'这里继续放保存文件的代码
End If
End Sub