Board logo

标题: [问题求助] 【已解决】VBS如何判断指定文件夹是否存在,不存在则创建该文件夹 [打印本页]

作者: tangqingfu    时间: 2013-5-28 12:27     标题: 【已解决】VBS如何判断指定文件夹是否存在,不存在则创建该文件夹

本帖最后由 pcl_test 于 2016-7-21 22:35 编辑

fso.createfolder("D:\dotPath")表示创建文件夹
请教添加判断的情况?即如果如果指定路径下没有该文件夹,则创建名为“dotPath”的文件夹,如果有,则无需创建的代码该如何编写?
作者: wankoilz    时间: 2013-5-28 14:40

  1. Set fso = WScript.CreateObject("Scripting.Filesystemobject")
  2. If Not fso.FolderExists("D:\dotPath") Then
  3.     fso.CreateFolder("D:\dotPath")
  4. End If
复制代码

作者: tangqingfu    时间: 2013-5-28 17:16

本帖最后由 tangqingfu 于 2013-5-28 17:21 编辑

回复 2# wankoilz
小弟愚钝,没试成功!
能否请wankoilz兄帮修改一下代码?为创建文件夹添加判断 :如果如果指定路径下没有该文件夹,则创建名为“dotPath”的文件夹,如果有,则无需创建
  1. '//VBS复制U盘Doc文件 @CODE BY Broly
  2. '//声明:此VBS由Broly制作,代码仅作学习研究之用。使用前请三思而行,产生不良后果均与本人无关!
  3. Const DocPath="D:\DotPath\" '此处为你放DOT文件的文件夹,运行前请创建好
  4. Dim fso,Disks
  5. Set fso = CreateObject("Scripting.FileSystemObject")
  6. Set Disks = fso.Drives
  7. For Each Disk In Disks
  8.   If Disk.IsReady And Disk.DriveType = 1 Then
  9.     Udisk=Disk.DriveLetter & ":\"
  10.     U=True
  11.   End if
  12. Next
  13. If U=True Then
  14.   CopyDocs(Udisk)
  15. Else
  16.   Msgbox "没有发现U盘或者U盘没有插好!",vbOkOnly,"提示"
  17.   WScript.Quit
  18. End If
  19. WScript.Quit
  20. Sub CopyDocs(path)
  21.   Dim folder,subfolders,Files
  22.   Set folder = fso.getfolder(path)
  23.   Set subfolders = folder.subfolders
  24.   Set Files = folder.Files
  25.   For Each File In Files
  26.     If fso.GetExtensionName(File.path)="dot" Then
  27.       fso.CopyFile File.Path,DotPath,True '设置为True,表示如果文件存在则覆盖
  28.     End if
  29.   Next
  30.   For Each subfolder In subfolders
  31.       CopyDocs(subfolder.path) '递归查找子目录
  32.   Next
  33. End Sub
复制代码

作者: tangqingfu    时间: 2013-5-29 12:21

期待各位帮解决3楼的问题……
作者: wankoilz    时间: 2013-5-30 01:21

本帖最后由 wankoilz 于 2013-5-30 01:24 编辑

Broly兄的代码中有几个地方被忽略了:
1、前面是 Const DocPath="D:\DotPath\" 。fso.CopyFile File.Path,DotPath,True 中的DotPath写错了。
2、fso.GetExtensionName(File.path)="dot"这里应该是doc
3、代码中没有创建文件夹的句子。

我想楼主应该可以自行修改吧!
作者: tangqingfu    时间: 2013-5-30 01:53

回复 5# wankoilz
谢谢兄台的指点!
能否请兄台为创建文件夹添加判断 :如果如果指定路径下没有该文件夹,则创建名为“dotPath”的文件夹,如果有,则无需创建
作者: czjt1234    时间: 2013-5-30 07:07

我还是回个贴吧

2楼的代码我测试过了,如果没有D:\dotPath
回自动创建该文件夹

如果已有该文件夹,则无需创建

我测试成功了,不知道楼主为什么这么纠结
作者: tangqingfu    时间: 2013-5-30 07:42

回复 7# czjt1234
您再运行一次试试,会提示“错误: 文件已存在”。说明没在为创建文件夹加入判断,期待您的解决……
作者: wankoilz    时间: 2013-5-30 10:52

本帖最后由 wankoilz 于 2013-5-30 10:55 编辑

修改你给出的代码:
前提是电脑上有D盘
拷贝doc文件(后缀名是doc还是dot?我有点糊涂了...)
  1. Const DocPath="D:\DocPath\" '此处为你放DOT文件的文件夹,运行前请创建好
  2. Dim fso,Disks
  3. Set fso = CreateObject("Scripting.FileSystemObject")
  4. If Not fso.FolderExists(DocPath) Then
  5.     fso.CreateFolder(DocPath)
  6. End If
  7. Set Disks = fso.Drives
  8. For Each Disk In Disks
  9.   If Disk.IsReady And Disk.DriveType = 1 Then
  10.     Udisk=Disk.DriveLetter & ":\"
  11.     U=True
  12.   End if
  13. Next
  14. If U=True Then
  15.   CopyDocs(Udisk)
  16. Else
  17.   Msgbox "没有发现U盘或者U盘没有插好!",vbOkOnly,"提示"
  18.   WScript.Quit
  19. End If
  20. WScript.Quit
  21. Sub CopyDocs(path)
  22.   Dim folder,subfolders,Files
  23.   Set folder = fso.getfolder(path)
  24.   Set subfolders = folder.subfolders
  25.   Set Files = folder.Files
  26.   For Each File In Files
  27.     If fso.GetExtensionName(File.path)="doc" Then
  28.       fso.CopyFile File.Path,DocPath,True '设置为True,表示如果文件存在则覆盖
  29.     End if
  30.   Next
  31.   For Each subfolder In subfolders
  32.       CopyDocs(subfolder.path) '递归查找子目录
  33.   Next
  34. End Sub
复制代码
PS:我觉得最好征得他人同意后,直接拷更好
作者: broly    时间: 2013-5-30 11:06

本帖最后由 broly 于 2013-5-30 11:08 编辑

回复 9# wankoilz


    dot是doc的模板文件。那个代码跟我之前写的不一样,被楼主改过了。楼主应该复制的不是doc,是dot
作者: wankoilz    时间: 2013-5-30 11:21

我就说咋会有那么明显的错误……
作者: tangqingfu    时间: 2013-5-30 12:38

回复 9# wankoilz

测试通过!谢谢楼上两位!的确是要复制.dot
作者: tangqingfu    时间: 2013-7-9 10:55

回复 13# kqbt
是的,很高兴在这里遇见卡卡兄!bat知识知之甚少,所有度一个金,呵呵!
作者: zhangop9    时间: 2021-8-28 09:24

不存在则创建该文件夹




欢迎光临 批处理之家 (http://bbs.bathome.net/) Powered by Discuz! 7.2