如图 我想实现 点击 一个按钮
让 D:
下的 关键字 为
张三、李四、王五 的TXT文件
让 D:
如图 我想实现 点击 一个按钮
让 D:\1 下的 关键字 为
张三、李四、王五 的TXT文件
自动拷贝到“D:\2”文件夹下 所对应 名字的 文件夹
万分感谢！！如果方便 希望传附件 给我！
遇到小白，一般都是这样的结果。
很多人都是不能清楚表达自己的需求的。
再说了，我也不是必须把“补丁”补完啊。
做这样的伸手党很不好啊！
把昨天准备给我的50块钱红包发给那个人吧，帮了你这么多忙。
光给你接电话都接了一个小时啊，拍拍屁股就走人了。
就是因为对这个开发人员这么不尊重，所以vb板块就这么没落了
价值和价格完全已经偏离了
最好的问题是，贴出代码，给出出错的部位，或者给出代码，或者表述这片代码目前得到的结果是aa期望的结果是bb，怎么解决？
而不是只管提需求，实现方面所有都让别人去做，你这扮演一个项目经理的角色。 要的是结果，而不是过程怎么实现的。
如果只是要成品可以去zbj.com或csto.com发项目
关于:你最终决定好需要如何处理吧，我按你的具体需求再编写一下代码。
有很多程序员，比较无私的，有很多人是比较无聊的。
把自己的尊严都给放弃了。
这个杨白劳自己一点都不动脑子，你还赶着往人家身上贴。
不过对我来说，那不管是有偿的还是无偿的，我都是喜欢，只要这个论坛能够红红火火的，而不是提出问题，几天几个月也没人回复，并且问题也是越来越少了。不是因为没有问题，而是回复的人太少。
这是我最后一次回复您的帖子。我承认 我的 编程基础 确实 太差 但也不是您说的那样子。谢谢。至于您 怎么说 是您的自由 我不会在这里回复这么无聊的话题。祝您买卖兴隆。
我觉得也是这样的，虽然理论上，他拿个40分积分来感谢人家。
他提出这么多要求，完全已经超过400分以上的难度了。
分不在多少最重要的他就是这样，这个伸手党自己不动脑子不努力。
每个程序员都这么懒的话，中国软件事业怎么可能进步。
中国的游戏就喜欢抄什么热血传奇，从来就不喜欢去创新，现在的人素质太差了。
多谢！我自己试试！
非常感谢您 终于成功了！
让 D:\1 下的 关键字 为
张三、李四、王五 的TXT文件
自动拷贝到“D:\2”文件夹下 所对应 名字的 文件夹
万分感谢！！如果方便 希望传附件 给我！
34 个解决方案
#1
可以发红包吗，我来参与
#2
谢谢您 我这个程序 这只是一个难点！如果您方便 希望您能帮助我！万分感谢！
#3
传附件给你表示什么意思？
是直接把编译好的exe程序给你吗？
是直接把编译好的exe程序给你吗？
#5
有高手吗 非常着急 希望得到您的帮忙
#6
自己不会写吗？用fso对象或者vb原生的方法遍历文件。 然后filecopy到指定目录。哪一步不会就问，我觉得这才是论坛正常的学习风气，伸手党拿完代码就走人，下次还是这样。看这id就是百度账号绑定登录进来新账号。
#7
我有一段代码 但 可能是太初级了 所以希望大家帮忙
#8
现在的人对开发人员不够尊重，如果那么简单，也就不会困扰这么久了
都希望别人白白给你做一个，难怪人有说现在码农还不如农民工了
万分感谢！！如果方便 希望传附件 给我！
传附件给你表示什么意思？
是直接把编译好的exe程序给你吗？
、
非常感谢您 我想要vb工程文件 源码 如果方便帮我传到 [email protected] 万分感谢
都希望别人白白给你做一个，难怪人有说现在码农还不如农民工了
万分感谢！！如果方便 希望传附件 给我！
传附件给你表示什么意思？
是直接把编译好的exe程序给你吗？
、
非常感谢您 我想要vb工程文件 源码 如果方便帮我传到 [email protected] 万分感谢
#9
新建一个“标准EXE”工程，窗体内画一个按钮。
运行后，点击按钮开始移动文件。
全部代码如下：
运行后，点击按钮开始移动文件。
全部代码如下：
Option Explicit
Private arrKeyWords() As String
Private arrPathList() As String
Private mlMaxIndex As Long
Private Sub Command1_Click()
' 按“关键字”移动文件
Dim strPath As String
Dim strFile As String
Dim i&, j As Long
strPath = "D:\1\" ' 源文件路径，末尾必须是 "\"
For i = 0& To mlMaxIndex
strFile = Dir$(strPath & arrKeyWords(i) & "*.txt")
Do
If ("" = strFile) Then Exit Do
Name strPath & strFile As arrPathList(i) & strFile
strFile = Dir$()
Loop
Next
End Sub
Private Sub Form_Load()
Dim strTemp As String
Dim i As Long, w As Long
arrKeyWords = Split("张三,李四,王五", ",")
w = UBound(arrKeyWords)
' 假设你的"D:\2"目录内必然有跟所有关键字对应的文件夹
mlMaxIndex = w
ReDim arrPathList(w)
For i = 0 To w
strTemp = Dir$("D:\2\" & arrKeyWords(i) & "*", vbDirectory)
arrPathList(i) = "D:\2\" & strTemp & "\"
Next
End Sub
#10
非常感谢您的帮助
只是我的水平确实 太低了
还有两个问题
一个是 这样的操作是 移动文件 如果 是拷贝文件 需要如何去处理
第二个 就是 如果 文件夹 里 除了那3个人 还是 陈六 赵七 刘八八 需要如何 自动获取呢？
真是万分感谢！您是我的恩人！
只是我的水平确实 太低了
还有两个问题
一个是 这样的操作是 移动文件 如果 是拷贝文件 需要如何去处理
第二个 就是 如果 文件夹 里 除了那3个人 还是 陈六 赵七 刘八八 需要如何 自动获取呢？
真是万分感谢！您是我的恩人！
#11
漫漫补丁路 @Chen8013
#12
如果是复制文件，把９楼代码第18行换成这一句就行：
Call FileCopy(strPath & strFile, arrPathList(i) & strFile)
如果要“自动获取关键字列表”，那么可以从“目标文件夹”列表入手。
但是，得有“确切的依据”从目录名中分离出关键字才行。
像你主楼图片中那样的情况，应该属于“无依据”的。
难道说“汉字就是关键字”？
这种说法是不靠谱的，万一有同名的呢！
出现“同名”的情况，在“记录表”上肯定要加后缀区分啊，这后缀一般就是1、2、3……或者a、b、c之类的。
很明显，代码是难以直接识别出某英文字符是否为“后缀”的。
其二，如果“人数多了”，文件数量自然也比较多。
处理时就应该先获取全部文件的清单（列表），然后从清单中取文件名来处理。
特别是有“人名”具有“包含关系”的情况时（比如李超、李超能； 或者胡杨、胡杨林），
必须先获取全部文件清单、还要对“关键字”进行倒序排序（估计楼主又得问如何实现排序了 ），
这样才能避免出现“重复处理”、“张冠李戴”之类的问题。
就以刚才提到的“李超、李超能”来说：
如果没有排序、并且先处理的是“李超”的，那么这时有关“李超能”的文件，也完全符合“李超”的关键字，
这样的结果就造成“李超”的文件夹中出现了李超能的文件。
但如果对关键字排序了，就能够避免：
先处理“李超能”的，这时“李超”的文件不能符合关键字，自然李超的文件不会出现在李超能的文件夹中；
对已经处理了的文件，从“文件清单”中把它移除。
在之后处理“李超”的文件时，由于列表中已经没有“李超能”的文件了，自然也不会“多出文件”来。
“事先获取全部文件清单”的好处来了：
一是只枚举了一遍文件，自然比枚举多遍的运行效率高一些；
二是“已经处理”了的，可以从列表中移除，可避免重复处理的情况。
注意，我在这儿提到的“清单”、“列表”都是指的一个字符串数组，并不是“列表控件”中的记录。
Call FileCopy(strPath & strFile, arrPathList(i) & strFile)
如果要“自动获取关键字列表”，那么可以从“目标文件夹”列表入手。
但是，得有“确切的依据”从目录名中分离出关键字才行。
像你主楼图片中那样的情况，应该属于“无依据”的。
难道说“汉字就是关键字”？
这种说法是不靠谱的，万一有同名的呢！
出现“同名”的情况，在“记录表”上肯定要加后缀区分啊，这后缀一般就是1、2、3……或者a、b、c之类的。
很明显，代码是难以直接识别出某英文字符是否为“后缀”的。
其二，如果“人数多了”，文件数量自然也比较多。
处理时就应该先获取全部文件的清单（列表），然后从清单中取文件名来处理。
特别是有“人名”具有“包含关系”的情况时（比如李超、李超能； 或者胡杨、胡杨林），
必须先获取全部文件清单、还要对“关键字”进行倒序排序（估计楼主又得问如何实现排序了 ），
这样才能避免出现“重复处理”、“张冠李戴”之类的问题。
就以刚才提到的“李超、李超能”来说：
如果没有排序、并且先处理的是“李超”的，那么这时有关“李超能”的文件，也完全符合“李超”的关键字，
这样的结果就造成“李超”的文件夹中出现了李超能的文件。
但如果对关键字排序了，就能够避免：
先处理“李超能”的，这时“李超”的文件不能符合关键字，自然李超的文件不会出现在李超能的文件夹中；
对已经处理了的文件，从“文件清单”中把它移除。
在之后处理“李超”的文件时，由于列表中已经没有“李超能”的文件了，自然也不会“多出文件”来。
“事先获取全部文件清单”的好处来了：
一是只枚举了一遍文件，自然比枚举多遍的运行效率高一些；
二是“已经处理”了的，可以从列表中移除，可避免重复处理的情况。
注意，我在这儿提到的“清单”、“列表”都是指的一个字符串数组，并不是“列表控件”中的记录。
#13
遇到小白，一般都是这样的结果。
#14
很多人都是不能清楚表达自己的需求的。
再说了，我也不是必须把“补丁”补完啊。
#15
真的是非常感谢您！ 苦口婆心！打开了我的任督二脉！
对于这个程序 我也从您这里 收获了 不少 然我 豁然开朗 。看您手打了这么多的汉字 真是对我受益匪浅。问题点数 40分 如何给您。这个真的是非常感谢。不知道您是哪里人 。我在北京，如果您来北京 我一定请您吃饭，交个朋友。真心感谢您。
最后 的最后 还想麻烦您个问题，
就是当我执行完 这段 程序 后 如何 生成 一个文件 比如 xxx.log 这里面列出 哪些文件 拷贝成功 哪些 是失败的。如果您方便可以最后再帮我看看。真是感激不尽。
对于这个程序 我也从您这里 收获了 不少 然我 豁然开朗 。看您手打了这么多的汉字 真是对我受益匪浅。问题点数 40分 如何给您。这个真的是非常感谢。不知道您是哪里人 。我在北京，如果您来北京 我一定请您吃饭，交个朋友。真心感谢您。
最后 的最后 还想麻烦您个问题，
就是当我执行完 这段 程序 后 如何 生成 一个文件 比如 xxx.log 这里面列出 哪些文件 拷贝成功 哪些 是失败的。如果您方便可以最后再帮我看看。真是感激不尽。
#16
真心感谢您，您很热心帮助我，不过您说的很对。我需要多学习。其实这个程序 是我很着急 想实现的功能，所以抓狂当中，真是希望好心人 帮我个忙。感谢您对我的帮助！
#17
你的“关键字”问题如何处理？
是否需要考虑我在12楼说的那种“包含关系”的问题？
输出Log的问题，也没难度，处理过程中另外用一个数组记录结果状态就行了。
对于“关键字列表”，要“自动识别”比较难，但有另一个方法比较方便“维护处理”：
就是另外创建一个比如叫“NameList.txt”的文件，跟exe程序文件放一起。
程序启动时，从这个文件读取列表就行了。
这个文件，格式就是每行一个名字。
需要处理的名字有增减，你只要改一下这个文件内容就行了。
你最终决定好需要如何处理吧，我按你的具体需求再编写一下代码。
是否需要考虑我在12楼说的那种“包含关系”的问题？
输出Log的问题，也没难度，处理过程中另外用一个数组记录结果状态就行了。
对于“关键字列表”，要“自动识别”比较难，但有另一个方法比较方便“维护处理”：
就是另外创建一个比如叫“NameList.txt”的文件，跟exe程序文件放一起。
程序启动时，从这个文件读取列表就行了。
这个文件，格式就是每行一个名字。
需要处理的名字有增减，你只要改一下这个文件内容就行了。
你最终决定好需要如何处理吧，我按你的具体需求再编写一下代码。
#18
首先 真的感谢您 这么晚了 还帮我回答问题！
您在12楼所说的 “关键字”问题如何处理 我最后解决方式是 人工输入 这样才会 避免 这样的问题发生 人工处理 姓名+身份证后四位。手工输入
现在 我只是希望 在处理完 这些文件后 生成一个 日志 这样 我可以知道 哪些文件 拷贝成功了 哪些失败了 拷贝到 的文件夹路径是否正确。
这样就行了 真是 感谢您！
这是我修改过的代码
您在12楼所说的 “关键字”问题如何处理 我最后解决方式是 人工输入 这样才会 避免 这样的问题发生 人工处理 姓名+身份证后四位。手工输入
现在 我只是希望 在处理完 这些文件后 生成一个 日志 这样 我可以知道 哪些文件 拷贝成功了 哪些失败了 拷贝到 的文件夹路径是否正确。
这样就行了 真是 感谢您！
这是我修改过的代码
Option Explicit
Private arrKeyWords() As String
Private arrPathList() As String
Private mlMaxIndex As Long
Private Sub Command1_Click()
Dim strTemp As String
Dim i1 As Long, w As Long
arrKeyWords = Split(Text1.Text, ",")
w = UBound(arrKeyWords)
' 假设"D:\2"目录内必然有跟所有关键字对应的文件夹
mlMaxIndex = w
ReDim arrPathList(w)
For i1 = 0 To w
strTemp = Dir$(Text3.Text & "\" & arrKeyWords(i1) & "*", vbDirectory) '数据库文件路径 末尾必须是 "\"
arrPathList(i1) = Text3.Text & "\" & strTemp & "\"
Next
' 按“关键字”移动文件
Dim strPath As String
Dim strFile As String
Dim i&, j As Long
strPath = Text2.Text & "\" ' PDF文档所在路径 源文件路径，末尾必须是 "\" 比如d:\1
For i = 0& To mlMaxIndex
strFile = Dir$(strPath & arrKeyWords(i) & "*.txt")
Do
If ("" = strFile) Then Exit Do
'剪切文件
'Name strPath & strFile As arrPathList(i) & strFile
'拷贝文件
Call FileCopy(strPath & strFile, arrPathList(i) & strFile)
strFile = Dir$()
Loop
Next
MsgBox "完成"
End Sub
Private Sub Form_Load()
Text1.Text = "张三,李四,王五"
Text2.Text = "d:\1" ' PDF文档所在路径 源文件路径
Text3.Text = "d:\2" '数据库文件路径
End Sub
#19
我觉得 您所想的
另外创建一个比如叫“NameList.txt”的文件，跟exe程序文件放一起。
程序启动时，从这个文件读取列表就行了。
我觉得更妥当 如果方便 帮我设计成这样 是最好！抱歉 麻烦您！
另外创建一个比如叫“NameList.txt”的文件，跟exe程序文件放一起。
程序启动时，从这个文件读取列表就行了。
我觉得更妥当 如果方便 帮我设计成这样 是最好！抱歉 麻烦您！
#20
做这样的伸手党很不好啊！
把昨天准备给我的50块钱红包发给那个人吧，帮了你这么多忙。
光给你接电话都接了一个小时啊，拍拍屁股就走人了。
就是因为对这个开发人员这么不尊重，所以vb板块就这么没落了
价值和价格完全已经偏离了
#21
@xiaoyao961
我真不想再说什么了
其实 CSDN 毕竟是个 技术交流平台
你却拿它当成你的 赚钱工具。在我的脑海里 你 只有两个字 交钱。要不叫是 加钱。算了我不想多说。您好自为之吧。
还有 我和其他人的事 跟您没有 关系 请您也不要 在这里 说三道四。谢谢。
最后我希望您生意兴隆，但真心希望 您不要 使用 CSDN 来招揽生意了。毕竟这是技术交流平台。你这样 只管 要钱 把这里弄得太那个了。谢谢。
我真不想再说什么了
其实 CSDN 毕竟是个 技术交流平台
你却拿它当成你的 赚钱工具。在我的脑海里 你 只有两个字 交钱。要不叫是 加钱。算了我不想多说。您好自为之吧。
还有 我和其他人的事 跟您没有 关系 请您也不要 在这里 说三道四。谢谢。
最后我希望您生意兴隆，但真心希望 您不要 使用 CSDN 来招揽生意了。毕竟这是技术交流平台。你这样 只管 要钱 把这里弄得太那个了。谢谢。
#22
本帖最后由 sysdzw 于 2016-07-30 09:38:31 编辑
哥们技术交流不是这样的，应该是自己写代码，写到不会的地方，比如具体到每个问题“怎么得到所有的文件名？”， “怎么得到字符串的左边两个字符？”，问问这些还能算扩充扩充论坛知识库，后来者搜到也能得到帮助不过还是建议应该先百度，自己解决，总得学会自己拿筷子吃饭吧，如果还是解决不了的再问。最好的问题是，贴出代码，给出出错的部位，或者给出代码，或者表述这片代码目前得到的结果是aa期望的结果是bb，怎么解决？
而不是只管提需求，实现方面所有都让别人去做，你这扮演一个项目经理的角色。 要的是结果，而不是过程怎么实现的。
如果只是要成品可以去zbj.com或csto.com发项目
#23
#24
明摆着就是不劳而获，还要人家给你发代码。
别人给你白写了一下，又要人家改要重新给你发代码。
像你这样做的话，每个人碰到问题都把它全部发上来，都当伸手党。
自己扮演的什么角色，就像是公司的一个老板一样碰到问题叫员工一次次去解决，那你最起码你也要付工资啊！
别人帮你处理问题啊，如果说需要点费用那也是正常的，当然有人免费给你写。
但是你这样堂而皇之的在这里呀，叫别人给你当杨白劳，完全就失去了一个程序员的资格。
别人给你白写了一下，又要人家改要重新给你发代码。
像你这样做的话，每个人碰到问题都把它全部发上来，都当伸手党。
自己扮演的什么角色，就像是公司的一个老板一样碰到问题叫员工一次次去解决，那你最起码你也要付工资啊！
别人帮你处理问题啊，如果说需要点费用那也是正常的，当然有人免费给你写。
但是你这样堂而皇之的在这里呀，叫别人给你当杨白劳，完全就失去了一个程序员的资格。
#25
关于:你最终决定好需要如何处理吧，我按你的具体需求再编写一下代码。
有很多程序员，比较无私的，有很多人是比较无聊的。
把自己的尊严都给放弃了。
这个杨白劳自己一点都不动脑子，你还赶着往人家身上贴。
不过对我来说，那不管是有偿的还是无偿的，我都是喜欢，只要这个论坛能够红红火火的，而不是提出问题，几天几个月也没人回复，并且问题也是越来越少了。不是因为没有问题，而是回复的人太少。
#26
这是我最后一次回复您的帖子。我承认 我的 编程基础 确实 太差 但也不是您说的那样子。谢谢。至于您 怎么说 是您的自由 我不会在这里回复这么无聊的话题。祝您买卖兴隆。
#27
我觉得也是这样的，虽然理论上，他拿个40分积分来感谢人家。
他提出这么多要求，完全已经超过400分以上的难度了。
分不在多少最重要的他就是这样，这个伸手党自己不动脑子不努力。
每个程序员都这么懒的话，中国软件事业怎么可能进步。
中国的游戏就喜欢抄什么热血传奇，从来就不喜欢去创新，现在的人素质太差了。
#28
1:万分感谢！！如果方便 希望传附件 给我！
2:这只是一个难点（注:就是有好多难点喽）！如果您方便
希望您能帮助我！
3:传附件给你表示什么意思？
是直接把编译好的exe程序给你吗？（人家要的不只是代码，还要求你们家把它写好，整个工程一打开就可以运行，可以编译）
4:我想要vb工程文件 源码 如果方便帮我传到 [email protected] 万分感谢
5:有高手吗 非常着急 希望得到您的帮忙（注:高手能没有吗？几千几万个也不是问题）
6:自己不会写吗？哪一步不会就问，我觉得这才是论坛正常的学习风气，伸手党拿完代码就走人，下次还是这样。看这id就是百度账号绑定登录进来新账号。
7:只是我的水平确实 太低了，还有两个问题 （注:何止是还有两个问题）
8:真是万分感谢！您是我的恩人！
（这让我想起了街上的那些骗子，有手有脚的在讨钱，但是把脚绑起来别人看不出来。然后这几天被那些城管揭穿了，这事情警察早就知道，只是都不去管罢了，相反，99%的百姓都是被骗了）骗子虽然可恶，但是警察城管也有责任
9:遇到小白，一般都是这样的结果。
10:再说了，我也不是必须把“补丁”补完啊。（这个问题说难也不难，说不难也麻烦，指手画脚叫别人做这个将来做那个，还要给你售后，好像赖上你了，我想你就应该对她负责到底）
11:真的是非常感谢您！ 苦口婆心！打开了我的任督二脉！（注:我在这个论坛里混了很多年了，从来没有一个人还说什么任督二脉，叫别人给你白打工就算了，还说的这么露骨）
12:对于这个程序 我也从您这里 收获了 不少 然我 豁然开朗 。看您手打了这么多的汉字 真是对我受益匪浅。问题点数 40分 如何给您（注:人家给你的只是汉字嘛，一大堆代码呢，最主要的是心情，这么一大堆高手围着你转，大家都成了你的码农）
13:不知道您是哪里人 。我在北京，如果您来北京 我一定请您吃饭，交个朋友。真心感谢您。
14:最后 的最后 还想麻烦你个问题…如果您方便可以最后再帮我看看。真是感激不尽。
15:其实这个程序 是我很着急 想实现的功能，所以抓狂当中
16:真是希望好心人 帮我个忙。感谢您对我的帮助！
17:你最终决定好需要如何处理吧，我按你的具体需求再编写一下代码。（好心人还是有的）
18:我只是希望这样就行了（该改改很多很多啊，哪里是两个问题，5个8个了） 真是 感谢您！
19:我觉得更妥当 如果方便 帮我设计成这样 是最好！抱歉 麻烦您！
20:我真不想再说什么了，其实 CSDN 毕竟是个 技术交流平台，你却拿它当成你的 赚钱工具。也并没有禁止，帮人家做商业作品收费服务啊！
也没有鼓励的个个白手党伸手党
红包这个事情呢？他这个要求越加越多啊，那我是价格肯定也是不一样的。
我说如果你是诚心的，可以走淘宝交易，结果他说你先全部给我写出来，把代码发过来，然后我再考虑把钱给你。他说先把前面的写出来，先给你50块钱，当初讲的时候是100。
钱这个事情了，单子接不接都无所谓，但是感觉被欺骗，被这样玩弄是最可恨的。
接电话聊天全部加起来一个小时左右，你说人家付个50块钱，是不是感觉很心寒啊！主要是从话里面就听不出诚意，如果说一个学生要做毕业设计真的希望别人帮助，辛苦点，赚个烟钱也可以。
看他这么着急，都不知道是帮什么单位做工程，我说一下子弄完就好了，他说他要晚上啊，要明天啊！天还不肯走淘宝交易非要你全部做完，再给她vbp工程源代码再付钱。
2:这只是一个难点（注:就是有好多难点喽）！如果您方便
希望您能帮助我！
3:传附件给你表示什么意思？
是直接把编译好的exe程序给你吗？（人家要的不只是代码，还要求你们家把它写好，整个工程一打开就可以运行，可以编译）
4:我想要vb工程文件 源码 如果方便帮我传到 [email protected] 万分感谢
5:有高手吗 非常着急 希望得到您的帮忙（注:高手能没有吗？几千几万个也不是问题）
6:自己不会写吗？哪一步不会就问，我觉得这才是论坛正常的学习风气，伸手党拿完代码就走人，下次还是这样。看这id就是百度账号绑定登录进来新账号。
7:只是我的水平确实 太低了，还有两个问题 （注:何止是还有两个问题）
8:真是万分感谢！您是我的恩人！
（这让我想起了街上的那些骗子，有手有脚的在讨钱，但是把脚绑起来别人看不出来。然后这几天被那些城管揭穿了，这事情警察早就知道，只是都不去管罢了，相反，99%的百姓都是被骗了）骗子虽然可恶，但是警察城管也有责任
9:遇到小白，一般都是这样的结果。
10:再说了，我也不是必须把“补丁”补完啊。（这个问题说难也不难，说不难也麻烦，指手画脚叫别人做这个将来做那个，还要给你售后，好像赖上你了，我想你就应该对她负责到底）
11:真的是非常感谢您！ 苦口婆心！打开了我的任督二脉！（注:我在这个论坛里混了很多年了，从来没有一个人还说什么任督二脉，叫别人给你白打工就算了，还说的这么露骨）
12:对于这个程序 我也从您这里 收获了 不少 然我 豁然开朗 。看您手打了这么多的汉字 真是对我受益匪浅。问题点数 40分 如何给您（注:人家给你的只是汉字嘛，一大堆代码呢，最主要的是心情，这么一大堆高手围着你转，大家都成了你的码农）
13:不知道您是哪里人 。我在北京，如果您来北京 我一定请您吃饭，交个朋友。真心感谢您。
14:最后 的最后 还想麻烦你个问题…如果您方便可以最后再帮我看看。真是感激不尽。
15:其实这个程序 是我很着急 想实现的功能，所以抓狂当中
16:真是希望好心人 帮我个忙。感谢您对我的帮助！
17:你最终决定好需要如何处理吧，我按你的具体需求再编写一下代码。（好心人还是有的）
18:我只是希望这样就行了（该改改很多很多啊，哪里是两个问题，5个8个了） 真是 感谢您！
19:我觉得更妥当 如果方便 帮我设计成这样 是最好！抱歉 麻烦您！
20:我真不想再说什么了，其实 CSDN 毕竟是个 技术交流平台，你却拿它当成你的 赚钱工具。也并没有禁止，帮人家做商业作品收费服务啊！
也没有鼓励的个个白手党伸手党
红包这个事情呢？他这个要求越加越多啊，那我是价格肯定也是不一样的。
我说如果你是诚心的，可以走淘宝交易，结果他说你先全部给我写出来，把代码发过来，然后我再考虑把钱给你。他说先把前面的写出来，先给你50块钱，当初讲的时候是100。
钱这个事情了，单子接不接都无所谓，但是感觉被欺骗，被这样玩弄是最可恨的。
接电话聊天全部加起来一个小时左右，你说人家付个50块钱，是不是感觉很心寒啊！主要是从话里面就听不出诚意，如果说一个学生要做毕业设计真的希望别人帮助，辛苦点，赚个烟钱也可以。
看他这么着急，都不知道是帮什么单位做工程，我说一下子弄完就好了，他说他要晚上啊，要明天啊！天还不肯走淘宝交易非要你全部做完，再给她vbp工程源代码再付钱。
#29
Option Explicit
Private arrKeyWords() As String
Private arrPathList() As String
Private mlMaxIndex As Long
Private Sub Command1_Click()
Open "c:\log.txt" For Append As #2 '写文件
Print #2, "日志文件"
Print #2, "○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○"
Close #2
Dim strTemp As String
Dim i1 As Long, w As Long
arrKeyWords = Split(Text1.Text, ",")
w = UBound(arrKeyWords)
' 假设"D:\2"目录内必然有跟所有关键字对应的文件夹
mlMaxIndex = w
ReDim arrPathList(w)
For i1 = 0 To w
strTemp = Dir$(Text3.Text & "\" & arrKeyWords(i1) & "*", vbDirectory) '数据库文件路径 末尾必须是 "\"
arrPathList(i1) = Text3.Text & "\" & strTemp & "\"
Next
' 按“关键字”移动文件
Dim strPath As String
Dim strFile As String
Dim i&, j As Long
strPath = Text2.Text & "\" ' PDF文档所在路径 源文件路径，末尾必须是 "\" 比如d:\1
For i = 0& To mlMaxIndex
strFile = Dir$(strPath & arrKeyWords(i) & "*.txt")
Do
If ("" = strFile) Then Exit Do
'剪切文件
'Name strPath & strFile As arrPathList(i) & strFile
'拷贝文件
Call FileCopy(strPath & strFile, arrPathList(i) & strFile)
strFile = Dir$()
Open "c:\log.txt" For Append As #2 '写文件
Print #2, " "
Print #2, "操作时间：" & Date & " " & Time & " 文件项目：" & strPath & strFile, arrPathList(i) & strFile
Close #2
Loop
Next
MsgBox "完成"
Open "c:\log.txt" For Append As #2 '写文件
Print #2, "●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●"
Close #2
End Sub
Private Sub Form_Load()
Text1.Text = "张三,李四,王五"
Text2.Text = "d:\1" ' PDF文档所在路径 源文件路径
Text3.Text = "d:\2" '数据库文件路径
End Sub
Private arrKeyWords() As String
Private arrPathList() As String
Private mlMaxIndex As Long
Private Sub Command1_Click()
Open "c:\log.txt" For Append As #2 '写文件
Print #2, "日志文件"
Print #2, "○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○○"
Close #2
Dim strTemp As String
Dim i1 As Long, w As Long
arrKeyWords = Split(Text1.Text, ",")
w = UBound(arrKeyWords)
' 假设"D:\2"目录内必然有跟所有关键字对应的文件夹
mlMaxIndex = w
ReDim arrPathList(w)
For i1 = 0 To w
strTemp = Dir$(Text3.Text & "\" & arrKeyWords(i1) & "*", vbDirectory) '数据库文件路径 末尾必须是 "\"
arrPathList(i1) = Text3.Text & "\" & strTemp & "\"
Next
' 按“关键字”移动文件
Dim strPath As String
Dim strFile As String
Dim i&, j As Long
strPath = Text2.Text & "\" ' PDF文档所在路径 源文件路径，末尾必须是 "\" 比如d:\1
For i = 0& To mlMaxIndex
strFile = Dir$(strPath & arrKeyWords(i) & "*.txt")
Do
If ("" = strFile) Then Exit Do
'剪切文件
'Name strPath & strFile As arrPathList(i) & strFile
'拷贝文件
Call FileCopy(strPath & strFile, arrPathList(i) & strFile)
strFile = Dir$()
Open "c:\log.txt" For Append As #2 '写文件
Print #2, " "
Print #2, "操作时间：" & Date & " " & Time & " 文件项目：" & strPath & strFile, arrPathList(i) & strFile
Close #2
Loop
Next
MsgBox "完成"
Open "c:\log.txt" For Append As #2 '写文件
Print #2, "●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●"
Close #2
End Sub
Private Sub Form_Load()
Text1.Text = "张三,李四,王五"
Text2.Text = "d:\1" ' PDF文档所在路径 源文件路径
Text3.Text = "d:\2" '数据库文件路径
End Sub
#30
算了，还是不要吵了吧。
我先贴一下我的源码：
我先贴一下我的源码：
Option Explicit
Private arrKeyWords() As String
Private arrPathList() As String
Private arrErrLog() As String
Private strPathSour As String
Private strPathDest As String
Private Function GetPath(Data As DataObject, ByVal Effect As Long) As String
Const ERR_TEXT As String = "只允许从“计算机”中拖入１个文件夹。"
Dim strRet As String
strRet = ""
If (7& = Effect) Then
If (1 = Data.Files.Count) Then
strRet = Data.Files(1&)
If (0 = (vbDirectory And GetAttr(strRet))) Then
strRet = ""
MsgBox Replace(ERR_TEXT, "１个", ""), 64
End If
Else
MsgBox ERR_TEXT, 64
End If
Else
MsgBox Replace(ERR_TEXT, "１个", ""), 64
End If
GetPath = strRet
End Function
Private Function ProcFiles() As Long
Dim aList() As String
Dim strFile As String
Dim i&, p&, m As Long
Dim u&, w&, v As Long
On Error GoTo E_Handle_LOG
v = 1&
Call GetAttr(strPathSour)
Call GetAttr(strPathDest)
' 重新加载KeyWords
w = lstKey.ListCount - 1
For i = 0& To w
arrKeyWords(i) = lstKey.List(i)
Next
' 获取目标路径列表
ReDim arrPathList(w)
For i = 0 To w
strFile = Dir$(strPathDest & arrKeyWords(i) & "*", vbDirectory)
arrPathList(i) = strPathDest & strFile & "\"
Next
' 获取文件清单
u = 127&: p = -1&
ReDim aList(u)
strFile = Dir$(strPathSour & "*.txt")
Do
If ("" = strFile) Then Exit Do
p = 1& + p
If (p > u) Then
u = 16& + u
ReDim Preserve aList(u)
End If
aList(p) = strFile
strFile = Dir$()
Loop
u = p ' 列表数据上界
' 复制文件
m = 7& Or u \ 4&
ReDim arrErrLog(m)
p = -1&
v = vbTrue
For i = 0& To w
w = 0&
Do
strFile = aList(w)
If (InStr(1&, strFile, arrKeyWords(i))) Then
Call FileCopy(strPathSour & strFile, arrPathList(i) & strFile)
If (0& = u) Then Exit Do
aList(w) = aList(u)
u = u - 1&
Else
w = 1& + w
End If
If (w > u) Then Exit Do
Loop
Next
v = 0&
E_Handle_LOG: ' 异常处理过程
If (v) Then
If (vbTrue = v) Then
p = 1& + p
If (p > m) Then
m = 8& + m
ReDim Preserve arrErrLog(m)
End If
arrErrLog(p) = strFile
Resume Next
Else
p = -2& ' 未预测的异常
End If
End If
ProcFiles = p ' 返回“出错记录”数据上界
End Function
Private Sub InitData()
Dim sTemp As String
Dim u&, i As Long
Dim iFn As Integer
txtSour.OLEDropMode = 1
txtDest.OLEDropMode = 1
iFn = FreeFile()
Open App.Path & "\NameList.txt" For Input As #iFn
u = 31&: i = -1&
ReDim arrKeyWords(u)
Do
If (EOF(iFn)) Then Exit Do
Line Input #iFn, sTemp
If ("" = sTemp) Then Exit Do
i = 1& + i
If (i > u) Then
u = 8& + u
ReDim Preserve arrKeyWords(u)
End If
arrKeyWords(i) = sTemp
Loop
Close iFn
For u = 0& To i
lstKey.AddItem arrKeyWords(u)
Next
End Sub
Private Sub OutErrLog(ByVal MaxIndex As Long)
Dim strFile As String
Dim i&, iFn As Integer
' 输出文件名格式为： ERR_年月日_时分秒.log
strFile = "\ERR_" & Format$(Now(), "yyyymmdd_hhnnss") & ".log"
iFn = FreeFile()
' 输出文件的位置是应用程序所在路径
Open App.Path & strFile For Output As #iFn
For i = 0& To MaxIndex
Print #iFn, arrErrLog(i)
Next
Close iFn
End Sub
Private Sub Start()
Dim sTemp As String
Dim n As Long
If (lstKey.ListCount = 0) Then
MsgBox "关键字列表不能为空。", 48
Exit Sub
End If
sTemp = txtSour.Text
If ("" = sTemp) Then
MsgBox "文件源路径没有输入。", 48
Exit Sub
End If
strPathSour = sTemp & "\"
sTemp = txtDest.Text
If ("" = sTemp) Then
MsgBox "文件目标路径没有输入。", 48
Exit Sub
End If
strPathDest = sTemp & "\"
n = ProcFiles()
If (0& > n) Then
If (vbTrue = n) Then
MsgBox "操作完成，所有文件成功复制。", 64
Else
MsgBox "出现未预料的错误，请检查路径是否正确！", 48
End If
Else
Call OutErrLog(n) ' 输出日志
MsgBox Replace("操作结束，有N个文件复制时出错。", "N", 1& + n), 64
End If
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdStart_Click()
Call Start
End Sub
Private Sub Form_Load()
Call InitData
End Sub
Private Sub lstKey_DblClick()
lstKey.RemoveItem lstKey.ListIndex
End Sub
Private Sub txtDest_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
txtDest.Text = GetPath(Data, Effect)
End Sub
Private Sub txtSour_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
txtSour.Text = GetPath(Data, Effect)
End Sub
#31
界面设计是这样的：
启动程序后，源路径、目标路径都可以从“计算机”中把目录拖入。
比如拖入你的： D:\1 和D:\2
那两个TextBox，设计时 Text属性是为空的，我写在那儿，是给我注明控件名称。
另外，就是工程所在目录（或exe文件所在目录）中，要有一个 NameList.txt 的文件。
这个文件就是每行一个名字（关键字）。
当然楼上的代码是没有处理“名字有包含关系”的。
毕竟暂时并没有这样的需求，写那么多也没有意义。
启动程序后，源路径、目标路径都可以从“计算机”中把目录拖入。
比如拖入你的： D:\1 和D:\2
那两个TextBox，设计时 Text属性是为空的，我写在那儿，是给我注明控件名称。
另外，就是工程所在目录（或exe文件所在目录）中，要有一个 NameList.txt 的文件。
这个文件就是每行一个名字（关键字）。
当然楼上的代码是没有处理“名字有包含关系”的。
毕竟暂时并没有这样的需求，写那么多也没有意义。
#32
右边是一个列表控件。
启动程序时，从NameList中读取的关键字会显示在它里面。
可以双击某项目，把它从列表中移除。
如果要实现“添加关键字”的功能，楼主先自己写下代码吧。
如果你实现了“添加”功能，注意在“' 重新加载KeyWords”那儿的For循环之前，
写一句： ReDim arrKeyWords(w)
启动程序时，从NameList中读取的关键字会显示在它里面。
可以双击某项目，把它从列表中移除。
如果要实现“添加关键字”的功能，楼主先自己写下代码吧。
如果你实现了“添加”功能，注意在“' 重新加载KeyWords”那儿的For循环之前，
写一句： ReDim arrKeyWords(w)
#33
多谢！我自己试试！
#34
非常感谢您 终于成功了！
下的 关键字 为
张三、李四、王五 的TXT文件
