Question

我将非常感谢您对此问题的帮助。我对宏很新。

我正在使用的宏是通过从B列单元格中获取文件名引用在Excel列A单元格中插入图片。

如果我知道子文件夹要搜索我需要的图片但我不知道如何在Z:\mfs\PictureLibrary的所有子文件夹中搜索，我有以下宏可以正常工作。

这是宏：

   Sub Picture()
   Dim picname As String

   Dim pasteAt As Integer
   Dim lThisRow As Long

lThisRow = 2

Do While (Cells(lThisRow, 2) <> "")


    pasteAt = lThisRow
    Cells(pasteAt, 1).Select 'This is where picture will be inserted


    picname = Cells(lThisRow, 2) 'This is the picture name

    present = Dir("Z:\mfs\PictureLibrary\Codello A14 Transfer\" & picname & ".jpg")

    If present <> "" Then

        ActiveSheet.Pictures.Insert("Z:\mfs\PictureLibrary\Codello A14 Transfer\" & picname & ".jpg").Select 'Path to where pictures are stored
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' This resizes the picture
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''
        With Selection
        '.Left = Range("A2").Left
        '.Top = Range("A2").Top
        .Left = Cells(pasteAt, 1).Left
        .Top = Cells(pasteAt, 1).Top

        .ShapeRange.LockAspectRatio = msoFalse
        .ShapeRange.Height = 55#
        .ShapeRange.Width = 40#
        .ShapeRange.Rotation = 0#
        End With



    Else
        Cells(pasteAt, 1) = ""
    End If

       lThisRow = lThisRow + 1
Loop

Range("A10").Select
Application.ScreenUpdating = True

Exit Sub

ErrNoPhoto:
MsgBox "Unable to Find Photo" 'Shows message box if picture not found
Exit Sub
Range("B20").Select

End Sub

Answer 1

请检查下面的示例，它会遍历子文件夹并搜索您的文件，您只需将其放入您的代码中：

Dim FileSystem As Object
Const mainFolder As String = "Z:\mfs\PictureLibrary\Codello A14 Transfer\"

Sub YourProblem()

    Dim filePath As String
    filePath = Find("pictureName.jpg")
    MsgBox filePath

End Sub

Function Find(picName As String) As String

    Set FileSystem = CreateObject("Scripting.FileSystemObject")
    Find = FindPicture(FileSystem.GetFolder(mainFolder), picName)

End Function

Function FindPicture(innerFolder, picName As String) As String

    Dim pictureFound As String
    pictureFound = Dir(innerFolder & "\" & picName)

    If Len(Trim(pictureFound)) > 0 Then
        FindPicture = innerFolder & "\" & pictureFound
        Exit Function
    Else
        Dim subFolder
        For Each subFolder In innerFolder.SubFolders

            pictureFound = FindPicture(subFolder, picName)
            If Len(Trim(pictureFound)) > 0 Then
                FindPicture = pictureFound
                Exit Function
            End If
        Next
    End If

End Function

用于在子文件夹中搜索图片的宏

1 个答案: