vbscript vba：打开文件或文件夹

Posted 2021-05-21

Sub open_file()
    Dim a$
    i = Selection.Row
    j = Rows("1:1").Find("地址").Column
    'j = Rows("1:1").Find("position").Column
    If Cells(i, j) = "" Then
        MsgBox "请选择有地址的行"
        Exit Sub
    End If
    a = "start " & Chr(34) & Chr(34) & " " & Chr(34) & Cells(i, j).Text & Chr(34)
    Call cmd1(a)
End Sub
Function cmd1(a)
    Set objshell = CreateObject("wscript.shell")
    Set DosExec = objshell.Exec("cmd.exe /c " & a) '调用cmd
    Set DosExec = Nothing
    Set objshell = Nothing
End Function
Sub open_folder()
    Dim a$
    i = Selection.Row
    On Error Resume Next
    j = Rows("1:1").Find("所在文件夹").Column
    'j2 = Rows("1:1").Find("地址").Column
    j2 = Rows("1:1").Find("position").Column
    'MsgBox TypeName(j)
    dopu = "D:\Program Files\Directory_Opus 11\App\DirectoryOpus64"
    If TypeName(j) <> "Empty" Then 'judge variate is empty,cooperate with "on error"
        If Cells(i, j) <> "" Then
            a = "start /d " & Chr(34) & dopu _
    & Chr(34) & " dopus.exe " & Chr(34) & Cells(i, j).Text & Chr(34)
            Call cmd1(a)
        End If
    Else
        If Cells(i, j2) = "" Then
            MsgBox "请选择有路径的行"
            Exit Sub
        Else
            a = "start /d " & Chr(34) & dopu _
    & Chr(34) & " dopus.exe " & Chr(34) & RootPath(Cells(i, j2).Text) & Chr(34)
        Call cmd1(a)
        End If
    End If
End Sub
Function RootPath(a$)
    For i = Len(a) To 1 Step -1
        If InStr("\", Mid$(a, i, 1)) Then Exit For
    Next
    RootPath = Mid$(a, 1, i - 1) '此处改
End Function