打开文件夹路径,但只知道部分文件夹名称

时间:2018-01-18 03:09:11

标签: excel vba excel-vba

我正在尝试使用宏来打开基于单元格内文件名的文件夹,这是我到目前为止的代码

Sub OpenFolder()

    Dim MyFolder As String
    Dim JobNumber As String
    Dim JobYearLeft As String
    Dim JobYear As String
    Dim FolderNumber As String
    Dim i As Integer

    JobNumber = Right(Range("A1"), Len(Range("A1")) - 3)
    JobYearLeft = Right(Range("A1"), Len(Range("A1")) - 1)
    JobYear = Left(JobYearLeft, Len(JobYearLeft) - 4)

    i = CInt(JobNumber)

    Select Case i
    Case 0 To 500
        FolderNumber = "0001_0500"
    Case 500 To 1000
        FolderNumber = "0501_1000"
    Case 1000 To 1500
        FolderNumber = "1001_1500"
    Case 1500 To 2000
        FolderNumber = "1501_2000"
    End Select

    If (JobYear = 17) Then
        MyFolder = "M:\2017\" & FolderNumber & "\"
    Else
        MyFolder = "M:\2016\" & FolderNumber & "\"
    End If

    MyFolder = Replace(MyFolder, " ", "")
    ActiveWorkbook.FollowHyperlink MyFolder

    MsgBox (MyFolder)
    MsgBox (i)
    MsgBox (JobNumber)
    MsgBox (FolderNumber)

End Sub

说我的文件夹路径是M:\2017\1501_2000\V171504******\ 其中****表示未知的部分,并且该字符串的长度不是常量,V171504是单元格“A1”中包含的值(MsgBox是我的测试,知道是否即时通讯获得正确的价值观。)

编辑,这是我尝试过的导演

FindFirstFile = Dir$(MyFolder & "*" & "/")

If (FindFirstFile <> "") Then
    FindFirstFile = Replace(FindFirstFile, " ", "")
    ActiveWorkbook.FollowHyperlink FindFirstFile
Else

End If

以下是整体情况

Sub OpenFolder()

Dim MyFolder As String
Dim JobNumber As String
Dim JobYearLeft As String
Dim JobYear As String
Dim FolderNumber As String
Dim i As Integer

JobNumber = Right(Range("A1"), Len(Range("A1")) - 3)
JobYearLeft = Right(Range("A1"), Len(Range("A1")) - 1)
JobYear = Left(JobYearLeft, Len(JobYearLeft) - 4)

i = CInt(JobNumber)

Select Case i
    Case 0 To 500
    FolderNumber = "0001_0500"
        Case 500 To 1000
        FolderNumber = "0501_1000"
            Case 1000 To 1500
            FolderNumber = "1001_1500"
                Case 1500 To 2000
                FolderNumber = "1501_2000"
End Select

If (JobYear = 17) Then
    MyFolder = "M:\2017\" & FolderNumber & "\"
    Else
        MyFolder = "M:\2016\" & FolderNumber & "\"
End If

MyFolder = Replace(MyFolder, " ", "")

Dim file As String
    file = Dir$(MyFolder & Range("A1").Value & "*" & "/")

If (Len(file) > 0) Then
 MsgBox "found" & file
 file = Dir$()
 ActiveWorkbook.FollowHyperlink file
End If

我目前在

收到错误消息
file = Dir$(MyFolder & Range("A1").Value & "*" & "\")

对于运行时错误'52' 文件名或号码错误

1 个答案:

答案 0 :(得分:0)

我找到了如何让它发挥作用

Sub OpenFolder()

Dim MyFolder As String
Dim JobNumber As String
Dim JobYearLeft As String
Dim JobYear As String
Dim FolderNumber As String
Dim i As Integer
Dim FirstFolder As String

JobNumber = Right(Range("A1"), Len(Range("A1")) - 3)
JobYearLeft = Right(Range("A1"), Len(Range("A1")) - 1)
JobYear = Left(JobYearLeft, Len(JobYearLeft) - 4)

i = CInt(JobNumber)

Select Case i
    Case 0 To 500
    FolderNumber = "0001_0500"
        Case 500 To 1000
        FolderNumber = "0501_1000"
            Case 1000 To 1500
            FolderNumber = "1001_1500"
                Case 1500 To 2000
                FolderNumber = "1501_2000"
End Select


If (JobYear = 17) Then
    FirstFolder = "M:\2017\" & FolderNumber & "\" '& Range("A1").Value & "*" & "\"
    Else
        MyFolder = "M:\2016\" & FolderNumber & "\" '& Range("A1").Value & "*" & "\"
End If

If (JobYear = 17) Then
    MyFolder = "M:\2017\" & FolderNumber & "\" & Range("A1").Value & "*" '& "\"
    Else
        MyFolder = "M:\2016\" & FolderNumber & "\" & Range("A1").Value & "*" '& "\"
End If

MyFolder = Replace(MyFolder, " ", "")

Dim OpenThisFolder As String
Dim GoToFolder As String

MyFolder = Dir(MyFolder, vbDirectory)

GoToFolder = FirstFolder & MyFolder & "\"
GoToFolder = Replace(GoToFolder, " ", "")

结束使用vbdirectory