vb 文件路径选择

概述  BaseForm '-----'BaseForm'-----'画面初期化Private Sub Form_Load() '磁盘路径 Drive_Path = "D:" '文件夹路径 Dir_Path = "D:" '新旧文件路径 Old_filepath_txt.Text = "

BaseForm

'-----'BaseForm'-----'画面初期化Private Sub Form_Load()        '磁盘路径    Drive_Path = "D:"        '文件夹路径    Dir_Path = "D:"        '新旧文件路径    old_filepath_txt.Text = ""    New_filepath_txt.Text = ""End SubPrivate Sub olD_xls_cmd_1_Click()    '原旧文件路径 取得    Select_file_Path = old_filepath_txt.Text    file_Select_From.Show 1        '旧文件路径 设定    old_filepath_txt.Text = Select_file_Path    End SubPrivate Sub NEW_xls_cmd_2_Click()    '原新文件路径 取得    Select_file_Path = New_filepath_txt.Text        file_Select_From.Show 1        '新文件路径 设定    New_filepath_txt.Text = Select_file_PathEnd Sub'比较按钮Private Sub Diffent_cmd_Click()        '输入的文件路径 检查    If filePath_Check = False Then        Exit Sub    End If        '新旧Excel 比较实施    Call Excel_diff                    MsgBox ("OK")    End Sub'输入的文件路径 检查Private Function filePath_Check() As Boolean        filePath_Check = True        '旧文件是否Excel文件检查    If Right(Trim(old_filepath_txt.Text),3) <> "xls" Then                '警告提示        MsgBox ("输入的旧文件并非EXCEL文件")                '旧文件输入框 光标选中        old_filepath_txt.SetFocus                filePath_Check = False                Exit Function    End If        '旧文件 是否存在检查    If Dir(old_filepath_txt.Text) = "" Then                '警告提示        MsgBox ("输入的旧文件不存在")                '旧文件输入框 光标选中        old_filepath_txt.SetFocus                filePath_Check = False                Exit Function    End If        '新文件是否Excel文件检查    If Right(Trim(New_filepath_txt.Text),3) <> "xls" Then                '警告提示        MsgBox ("输入的新文件并非EXCEL文件")                '新文件输入框 光标选中        New_filepath_txt.SetFocus                filePath_Check = False                Exit Function    End If        '新文件 是否存在检查    If Dir(New_filepath_txt.Text) = "" Then                '警告提示        MsgBox ("输入的新文件不存在")                '新文件输入框 光标选中        New_filepath_txt.SetFocus                filePath_Check = False                Exit Function    End If        '新旧文件路径 是否相同检查    If Trim(old_filepath_txt.Text) = Trim(New_filepath_txt.Text) Then            '警告提示        MsgBox ("输入的新旧文件路径相同 为同一个文件")                '旧文件输入框 光标选中        old_filepath_txt.SetFocus                filePath_Check = False                Exit Function        End IfEnd Function'新旧Excel 比较实施Private Sub Excel_diff()        '创建EXCEL应用类    Dim MyXls As Object    Set MyXls = CreateObject("Excel.Application")        '旧Excel文件    Dim old_WorkBook As Object    Set old_WorkBook = MyXls.Workbooks.Open(Trim(old_filepath_txt.Text))        '新Excel文件    Dim New_WorkBook As Object    Set New_WorkBook = MyXls.Workbooks.Open(Trim(New_filepath_txt.Text))        '新旧Excel比较结果Excel文件    Dim Result_WorkBook As Object    Set Result_WorkBook = MyXls.Workbooks.Add        Dim i As Integer    Dim j As Integer        '旧Excel文件Sheet循环    For i = 1 To old_WorkBook.sheets.Count                '新Excel文件Sheet循环        For j = 1 To New_WorkBook.sheets.Count                        '新旧excel文件中相同sheet名的sheet作对比            If old_WorkBook.sheets(i).name = New_WorkBook.sheets(j).name Then                                '复制旧文件中要做对比的sheet至 结果Excel 复制至最后位置sheet                old_WorkBook.sheets(i).copy After:=Result_WorkBook.Worksheets(Result_WorkBook.sheets.Count)                                '                '具体处理。。。                '            End If                    Next            Next            '新旧Excel文件关闭    old_WorkBook.Close (True)    New_WorkBook.Close (True)        '比较结果Excel文件多余sheet删除    If Result_WorkBook.sheets.Count > 3 Then                For i = Result_WorkBook.sheets.Count To 1 Step -1                        If Result_WorkBook.sheets(i).name = "Sheet1" _                Or Result_WorkBook.sheets(i).name = "Sheet2" _                Or Result_WorkBook.sheets(i).name = "Sheet3" Then                Result_WorkBook.sheets(i).Delete            End If                    Next        End If            'EXCEL文件可见    MyXls.Visible = True    End Sub'旧文件路径输入框 光标进入Private Sub old_filepath_txt_GotFocus()    old_filepath_txt.SelStart = 0    old_filepath_txt.SelLength = Len(old_filepath_txt.Text)    End Sub'新文件路径输入框 光标进入Private Sub New_filepath_txt_GotFocus()        New_filepath_txt.SelStart = 0    New_filepath_txt.SelLength = Len(New_filepath_txt.Text)    End Sub

file_Select_Form

'--------------------'文件选择目录 联动设定'--------------------' 联动FlgPrivate Init_Flg As String '初期化时 各列表框不联动(0:初期化,1：非初期化)'画面初期化Private Sub Form_Load()        '初期化开始Flg    Init_Flg = "0"        '磁盘    Drive1.Drive = Drive_Path        '文件夹    Dir1.Path = Dir_Path        '文件    file1.Path = Dir_Path        '初期化结束Flg    Init_Flg = "1"End Sub'磁盘列表 选择变更Private Sub Drive1_Change()        '非初期化时 变更的场合 联动实施    If Init_Flg = "1" Then            Drive_Path = Drive1.Drive                '文件夹列表 联动        Dir1.Path = Drive1.Drive            End IfEnd Sub'文件夹列表 选择变更Private Sub Dir1_Change()    '非初期化时 变更的场合 联动实施    If Init_Flg = "1" Then                Dir_Path = Dir1.Path                '文件列表 联动        file1.Path = Dir1.Path        End If    End Sub'文件列表 双击Private Sub file1_DblClick()        Call Return_file_Path    End Sub'选择按钮 按下Private Sub Select_cmd_Click()    Call Return_file_Path    End Sub'返回文件路径 并关闭窗口Private Sub Return_file_Path()        '取得的文件路径 设定    Select_file_Path = Dir1.Path        If Right(Dir1.Path,1) <> "\" Then        Select_file_Path = Select_file_Path & "\"    End If        Select_file_Path = Select_file_Path & file1.filename        '关闭窗口    Unload Me    End Sub

Module1

'磁盘路径 全局变量Global Drive_Path As String'文件夹路径 全局变量Global Dir_Path As String'取得Excel文件路径Global Select_file_Path As String

总结

以上是内存溢出为你收集整理的vb 文件路径选择全部内容，希望文章能够帮你解决vb 文件路径选择所遇到的程序开发问题。

如果觉得内存溢出网站内容还不错，欢迎将内存溢出网站推荐给程序员好友。