按PDF文件名称分类到对应文件夹

duquancai

川黔1985 发表于 2017-11-28 22:37
完美解决 谢谢老师出手  问题没写清除耽误您时间了

这个世上没有完美的东些！！！！

小川1985

闻启学 发表于 2017-11-28 22:59
楼上用字典来 我来一个 FSO

谢谢出手相助 感谢万分

小川1985

duquancai 发表于 2017-11-28 23:27
Sub pdf文件_分类归档()
    Dim pa$, reg As Object, d As Object, sr$, k, t, fol As Object
    Dim f ...

很强大！！！！！

小川1985

huang1314wei 发表于 2017-11-28 22:29

提示子过程或函数未定义。  RegString未定义》？？？

小川1985

duquancai 发表于 2017-11-28 23:27
Sub pdf文件_分类归档()
    Dim pa$, reg As Object, d As Object, sr$, k, t, fol As Object
    Dim f ...

测试可用 完美解决 谢谢 感谢帮助

huang1314wei

小川1985 发表于 2017-11-29 09:02
提示子过程或函数未定义。  RegString未定义》？？？

你应该问原作者，代码不是我写的

小川1985

闻启学 发表于 2017-11-28 22:57
我来一个FSO

我

提示子过程或函数未定义

duquancai

小川1985 发表于 2017-11-29 09:08
测试可用 完美解决 谢谢 感谢帮助

没有完美的。还有很多缺陷。。。。。

jackie_929

1. Sub PDF文件分类()
   
2.     Dim fso As Object, reg As Object, mPath As String
   
3.     Set reg = CreateObject("VBScript.RegExp")
   
4.     Set fso = CreateObject("Scripting.FileSystemObject")
   
5.     Set fls = fso.GetFolder(ThisWorkbook.Path).Files
   
6.     With fso
   
7.         For Each i In fls
   
8.             If .GetExtensionName(i) = "pdf" Then
   
9.                 reg.Pattern = "\d+$"
   
10.                 mPath = .BuildPath(ThisWorkbook.Path, reg.Replace(.GetBaseName(i), "")) & ""
    
11.                 If Not .FolderExists(mPath) Then
    
12.                     .CreateFolder (mPath)
    
13.                 End If
    
14.                 .MoveFile i.Path, mPath
    
15.             End If
    
16.         Next
    
17.     End With
    
18. End Sub

复制代码

正在学习正则表达式和FSO，弄了一上午，当作练习了 ：）

sunny_8848

代码效率很高，学习了