[源代码分享计划]（一）Visual Basic文件操作程序

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