[源代码分享计划]（一）Visual Basic文件操作程序
标题：Visual Basic文件操作程序适用类：对文件的读取，删除，编辑，复制等操作。包括更改驱动器默认盘符，创建新文件夹等。
编译工具：Visual Basic6.0
界面：
控件集：
4个TextBox，11个Label标签，2个Combo控件，9个Command按钮，1个DriveListBox，1个DirListBox，一个FileListBox
代码：（包括注释+讲解）
程序代码：Option Explicit '*************************************************** '因为我个人也是一个菜鸟，所以有些代码是来自不同的教材中 '不著明版权，学习交流之用 '发布在https://bbs.bccn.net/编程论坛。 '*************************************************** Private Sub Combo1_Change() File1.Pattern = Combo1.Text '将Combo1文本框中的文本作为字符串值，赋值给File1的文件过滤 Label6.Caption = "当前过滤条件为：" & Combo1.Text '交互设计输出即时操作。 End Sub Private Sub Combo1_Click() File1.Pattern = Combo1.Text '同上 Label6.Caption = "当前过滤条件为：" & Combo1.Text End Sub Private Sub Command1_Click() On Error GoTo Err1 '设定错误捕获程序 Dim a As String '设定a 为字符串型变量 a = InputBox("请输入要更改的默认盘符。", "更改默认盘符") '用Iputbox 来输入要更改默认盘符信息 ChDrive a '更改默认盘符 MsgBox "更改成功，更改后的默认盘符为：" & a, vbOKOnly + vbInformation, "信息提示" '交互设计 If Err.Number = 68 Then '若错误代码为68，则触发错误捕获程序 Exit Sub GoTo Err1 Err1: MsgBox "更改错误，您所更改的默认盘符无效！" & Chr(13) & "可能的错误原因：" & Chr(13) & "所输入的盘符号不存在！", vbOKOnly + vbCritical, "错误提示" Rem 触发错误提示 End If End Sub Private Sub Command2_Click() If MsgBox("请注意！确认要删除本文件吗？此操作不可逆。", vbYesNo + vbExclamation, "询问") = vbYes Then Rem 用msg函数返回一个值，判断按下哪个按钮，如果按下“是”按钮，执行Then后面的语句，否则不执行任何操作。 Kill File1.Path & "\" & File1.FileName '删除相关文件 File1.Refresh '刷先File1文件列表 MsgBox "删除" & Label5.Caption & "成功！", vbOKOnly + vbInformation, "删除成功" Rem 交互设计，告诉用户，删除成功了。如果有msg函数不懂的，先买本书看看吧，基础的东西。 'MsgBox "删除" & File1.Path & "\" & File1.FileName & "成功！" 暂时不用 End If End Sub Private Sub Command3_Click() On Error GoTo Err1 '设置错误捕获程序 Dim a As String '设置a 为字符串型变量，用于inputbox的字符串存储 a = InputBox("请输入您要创建的文件夹名。", "创建文件夹名") '定义新的文件夹名称 MkDir a '创建新的文件夹，默认存储路径为本程序所在的根目录 MsgBox "创建文件夹成功。", vbOKOnly + vbInformation, "信息提示" Rem '交互设计，前面讲到了。 If Err.Number = 75 Then '如果错误代码为75，则触发错误捕程序 GoTo Err1 Err1: MsgBox "创建错误，已有此文件夹，请更换文件夹名称！", vbOKOnly + vbCritical, "信息提示" End If End Sub Private Sub Command4_Click() If Text1.Text = "" Or Text2.Text = "" Then Rem 判断Text1或text2文本框是否为空，为空则执行Then后面的语句 MsgBox "错误，文本框中的内容不能为空！", vbOKOnly + vbCritical, "信息提示" Else '否则执行文件的复制操作。 FileCopy Text1.Text, Text2.Text '复制Text1文本中框的文本位置到Text2文本框中的文本位置 MsgBox "复制成功，复制的新位置为：" & CommonDialog1.FileName, vbOKOnly + vbInformation, "信息提示" Rem 交互设计 Text1.Text = "" '清空文本框 Text2.Text = "" End If End Sub Private Sub Command5_Click() CommonDialog1.ShowOpen '调用ShowOpen方法 Text1.Text = CommonDialog1.FileName '将CommonDialog1的文件名称赋值给Text1 End Sub Private Sub Command6_Click() CommonDialog1.ShowSave '调用ShowsSave方法 Text2.Text = CommonDialog1.FileName '将CommonDialog1的文件名称赋值给Text2 End Sub Private Sub Command7_Click() Name TextYuanName.Text As TextNewName.Text '用name...as...来实现更改文件名称 MsgBox "更名成功！新的文件名称为：" & TextNewName.Text, vbOKOnly + vbInformation, "更名成功" Rem 交互设计 TextYuanName.Text = "" ' 清空相关文本框 TextNewName.Text = "" End Sub Private Sub Command8_Click() CommonDialog1.ShowSave '调用ShowsSave方法 TextNewName.Text = CommonDialog1.FileName '将CommonDialog1的文件名称赋值给TextNewName End Sub Private Sub Command9_Click() CommonDialog1.ShowOpen '调用ShowOpen方法 TextYuanName.Text = CommonDialog1.FileName '将CommonDialog1的文件名称赋值给TextYuanName End Sub Private Sub Dir1_Change() '事件不用多说了。同Drive1_Change事件 File1.Path = Dir1.Path '设置文件路径与Dir的关联关系。 End Sub Private Sub Drive1_Change() '当选择驱动器发生改变时发生的事件。 On Error GoTo Err1 '设置错误捕获程序 Dir1.Path = Drive1.Drive '设置Dir与驱动器的关联关系 If Err.Number = 68 Then '当错误代码为68时，触发错误捕获程序 GoTo Err1 'Goto语句跳转到Err1 Err1: MsgBox "驱动器读取错误！您尚未插入有效设备，请插入后重试。", vbOKOnly + vbCritical, "错误提示" Rem 交互设计，弹出错误提示框，并将驱动器设为默认盘符C Drive1.Drive = "C:\" End If End Sub Private Sub File1_Click() Dim Str As String '定义变量Str为字符串类型数据 If Right(File1.Path, 1) = "\" Then Rem 用right函数来判断文件路径字符的右边第一位字符是否为"\"，若是则执行Then后面的语句，不是则执行Else后面的语句。 Rem 我个人认为这是画蛇添足。因为在XP系统中定义文件名不允许出现"\"字符 Rem Right 函数不懂的新手，可以百度了解一下。 Str = File1.Path & File1.FileName '将文件路径+文件名称赋值给Str Else Str = File1.Path & "\" & File1.FileName '将文件路径+"\"+文件名称赋值给Str End If Label5.Caption = Str '将字符串函数Str的值赋给Label5的标签，以显示当前的文件路径 End Sub Private Sub Form_Load() '窗体的加载事件（即窗体一载入内存时发生的事件） Label5.Caption = "正在获取文件路径......" Rem 设置当窗体载入内存时，Lbel5的Caption属性为提示语 Label6.Caption = "当前的过滤条件为空." Rem 同上 Combo1.AddItem ("*.*") '向Combo控件中添加项目，以后做过滤条件用 Combo1.AddItem ("*.txt") Combo1.AddItem ("*.exe") Combo1.AddItem ("*.doc") Combo1.AddItem ("*.frm") Combo1.AddItem ("*.jpg") Combo1.AddItem ("*.png") Combo1.AddItem ("*.ico") End Sub
程序：
VB文件操作.zip
(13.18 KB)
大家对代码有任何疑问都可以提出，能帮助大家的一定帮助。
[ 本帖最后由 VB丶小宇 于 2015-4-16 13:34 编辑 ]
