HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Importing JPG, JPEG, and PNG images from a folder to an Excel worksheet

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
pngimagesexcelworksheetfolderjpgandimportingfromjpeg

Problem

As I am a novice, I was keen to solve the task, so now I want to optimize the code.

Sub AddOlEObject()

    Dim mainWorkBook As Workbook

    Set mainWorkBook = ActiveWorkbook
    Sheets("SingleProfile").Activate
    Folderpath = "C:\Users\sandeep.hc\Pics"
    Set fso = CreateObject("Scripting.FileSystemObject")
    NoOfFiles = fso.GetFolder(Folderpath).Files.Count
    Set listfiles = fso.GetFolder(Folderpath).Files
    For Each fls In listfiles
       strCompFilePath = Folderpath & "\" & Trim(fls.Name)
        If strCompFilePath <> "" Then
            If (InStr(1, strCompFilePath, "jpg", vbTextCompare) > 1 _
            Or InStr(1, strCompFilePath, "jpeg", vbTextCompare) > 1 _
            Or InStr(1, strCompFilePath, "png", vbTextCompare) > 1) Then
                 counter = 29
                 counter1 = counter1 + 1

                Call insert(strCompFilePath, counter, counter1)
                'Sheets("SingleProfile").Activate
                counter1 = counter1 + 17
            End If
        End If
    Next
mainWorkBook.Save
End Sub

Function insert(PicPath, counter, counter1)
'MsgBox PicPath
    With ActiveSheet.Pictures.insert(PicPath)
        With .ShapeRange
            .LockAspectRatio = msoFalse
            .Width = 875
            .Height = 300
        End With
        .Left = ActiveSheet.Cells(counter, counter1).Left
        .Top = ActiveSheet.Cells(counter, counter1).Top
        .Placement = 1
        .PrintObject = True
    End With
End Function


Based on Comments Optimized code

```
Sub AddImage2()
Dim rgTarget As Range
Dim RowI As Long, ColumnI As Long

Folderpath = "C:\Users\sandeep.hc\Pics"
Set fso = CreateObject("Scripting.FileSystemObject")
NoOfFiles = fso.GetFolder(Folderpath).Files.Count
Set listfiles = fso.GetFolder(Folderpath).Files
For Each fls In listfiles
strCompFilePath = Folderpath & "\" & Trim(fls.Name)
If strCompFilePath <> "" Then
If (InStr(1, strCompFilePath, "jpg", vbTextCom

Solution

I will summarize what I said before (and add a few new ones):

-
Use Option Explicit at the top of your module. It helps you to prevent mistakes and forces you to declare the variables

-
instead of Instr use Right as in If Right(strCompFilePath,4)=".jpg"

-
rename counter and counter1 so it is clear what they are (row and column indices)

-
Declare insert as a Sub and not a Function.

-
instead of passing the row and column index to the insert function/sub and then using the ActiveSheet pass the cell as a Range to the insert function/sub. (Instead of Activesheet you can use cell.Worksheet to get the right sheet)

-
possibly rename insert so you don't confuse it with Pictures.insert

-
add the option savewithfile := true to the Pictures.Insert method so the pictures will stay in the file even if you send it somewhere.

-
as it is now, you don't really need NoOfFiles and mainWorkBook

-
instead of the FileSystemObject I would use Dir. See this for more on that.

Context

StackExchange Code Review Q#129828, answer score: 4

Revisions (0)

No revisions yet.