在宏中递归查找所有文件(png)

时间:2015-02-24 12:02:42

标签: excel vba excel-vba

我有两个与以下代码相关的问题。 代码当前在文件夹中搜索所有文件,并将FileName,FilePath和图片添加到工作表中。

问题1)

这很愚蠢,但如何添加If statement只能将*.png个文件添加到工作表中。我试过.EndsWith(".png")但是我收到了编译错误。

问题2)

如何更改此功能以递归方式搜索所有文件?

Sub AddPicture()
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim i As Integer
    Dim aString As String

    Cells(1, 1) = "Name"
    Cells(1, 2) = "Path"
    Cells(1, 3) = "Picture"

    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Get the folder object
    Set objFolder = objFSO.GetFolder("C:\Pictures\")
    i = 1
    'loops through each file in the directory and prints their names and path
    For Each objFile In objFolder.Files
            'print file name
            Cells(i + 1, 1) = objFile.name
            'print file path
            Cells(i + 1, 2) = objFile.path
            AddPicOverCell objFile.path, objFile.name, ActiveSheet.Cells(i + 1, 3)
            Rows(i + 1).RowHeight = 85
            i = i + 1
    Next objFile
End Sub

Sub AddPicOverCell(path As String, filename As String, rngRangeForPicture As Range)
    With Application
    Dim StartingScreenUpdateing As Boolean
    Dim StartingEnabledEvent As Boolean
    Dim StartingCalculations As XlCalculation

    StartingScreenUpdateing = .ScreenUpdating
    StartingEnabledEvent = .EnableEvents
    StartingCalculations = .Calculation

        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With

    Dim Top As Single, Left As Single, Height As Single, Width As Single
    Dim file As String
    Dim ws As Worksheet

    file = path

    Top = rngRangeForPicture.Top
    Left = rngRangeForPicture.Left
    Height = 85 'rngRangeForPicture.Height
    Width = 85 'rngRangeForPicture.Width

    Set ws = rngRangeForPicture.Worksheet

    ws.Shapes.AddPicture file, msoCTrue, msoTrue, Left, Top, Width, Height

    With Application
        .ScreenUpdating = StartingScreenUpdateing
        .EnableEvents = StartingEnabledEvent
        .Calculation = StartingCalculations
    End With
End Sub

0 个答案:

没有答案