我有两个与以下代码相关的问题。 代码当前在文件夹中搜索所有文件,并将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