search当前文件夹

此Excel VBA代码创build超链接到A列中的项目列表,从FIXED位置创build相应的文件夹名称。 例如:

Room101 is hyperlinked to C:\Files\Pictures\Room101 Room102 is hyperlinked to C:\Files\Pictures\Room102 Room103 is hyperlinked to C:\Files\Pictures\Room103 

我一直在试图重新devise文件夹的目的地更加dynamic,特别是search文件夹应该是Excel文件的当前文件夹。 请参阅第7行的代码:

 Option Explicit Dim lngRow Public Sub Aufruf() Dim lngTMP As Long lngTMP = ActiveSheet.Cells(Cells(Rows.Count, "A").End(xlUp).Row, 1).Row For lngRow = 1 To lngTMP searchDir "M:\Pictures" 'fixed folder location Next lngRow End Sub Private Sub searchDir(strDir) Dim objSubDir As Object Dim strName As String Dim objFSO As Object Dim objDir As Object On Error Resume Next Set objFSO = CreateObject("Scripting.FileSystemObject") Set objDir = objFSO.getfolder(strDir) For Each objSubDir In objDir.subfolders strName = StrReverse(Split(StrReverse(objSubDir.Path), "\")(0)) If strName = Cells(lngRow, 1).Text Then ActiveSheet.Hyperlinks.Add Anchor:=Cells(lngRow, 1), Address:= _ objSubDir.Path & "\", TextToDisplay:=Cells(lngRow, 1).Text Exit Sub End If searchDir objSubDir Next Set objFSO = Nothing Set objDir = Nothing End Sub 

您会注意到文件path被固定为“M:\ Pictures”。

如何searchExcel文档保存的文件夹? 我曾尝试使用以下变体:

 path = ActiveWorkbook.Path