Iterate Directory Deleting Then Importing Image

I feel like I am close to having my syntax set, but the compile immediately highlights certain lines red showing me they are incorrect, and I do not know how to select a designated cell in VBA. What I want to do is open a template workbook, copy an image form that workbook. Then open all workbooks in a directory, delete an image from sheet1, paste the copied image, delete an image from sheet2 and paste the copied image, save, close, next workbook.

This is my syntax, can someone help me out on what to get this working?

Sub ReplaceImage()

Dim fList() As String, fName As String, fPath As String
Dim intFno As Integer
Dim rngPaste As Range
Dim WB As Workbook, wbOpened As Workbook
Dim strmasterFile As String
Dim shape as Excel.shape

strMasterFile = “C:\Image_Template.xlsx”
Set wbOpened = Workbooks.Open(strmasterFile)
With Sheets(1)
    if shape.name = "Picture 1" Then
        shape.Select
        Selection.Copy
    end if
 End With
Set WB = ActiveWorkbook
fPath = “C:\NewFormat\” & “\”
If MsgBox(“Collect all sample files in the current dir:” & vbCrLf & fPath, vbYesNo) = vbYes Then
intFno = 0
fName = Dir(fPath & “ * .xlsx”)

While fName <> “”
intFno = intFno + 1
ReDim Preserve fList(1 To intFno)
fList(intFno) = fName
fName = Dir()
Wend

  If intFno = 0 Then
    MsgBox “No files found”
  Exit Sub
  End If
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  For intFno = 1 To UBound(fList)
  On Error GoTo Skip
  Set wbOpened = Workbooks.Open(fPath & fList(intFno))
  With Sheets(1)
    For Each shape In ActiveSheet.Shapes
    if shape.name = "Picture 19" Then
      shape.Delete
    end if
 next
'Paste Image to Cell A84 and of course it will expand across
End With
With Sheets(2)
  For Each shape In ActiveSheet.Shapes
  if shape.name = "Picture 6" Then
    shape.Delete
  end if
next
'Paste Image to Cell A88 and of course it will expand across
End With
wbOpened.Close False
Skip:
Next
Else: End If

End Sub

EDIT -- These are the culprit lines that immediately get font color changed to red

strMasterFile = “C:\Image_Template.xlsx”

fPath = “C:\NewFormat\” & “\”
If MsgBox(“Collect all sample files in the current dir:” & vbCrLf & fPath, vbYesNo) = vbYes Then

MsgBox “No files found”

Removing the smart quotes got rid of the immediate red-liners!!!! Now for my last piece of the pie..how to actually paste the image to the desired cell on each worksheet?

One step close-1st iteration will go issue free, 2nd workbook throws an error of

Paste method of worksheet class failed

On this line

ActiveSheet.Paste

And this is my full-updated code

Sub ReplaceImage()

Dim fList() As String, fName As String, fPath As String
Dim intFno As Integer
Dim rngPaste As Range
Dim WB As Workbook, wbOpened As Workbook
Dim strmasterFile As String
Dim shape As Excel.shape

strmasterFile = "C:\Image_Template.xlsx"
Set wbOpened = Workbooks.Open(strmasterFile)
With Sheets(1)
  Rows("1:4").Select
  Selection.Copy
End With
Set WB = ActiveWorkbook
fPath = "C:\NewFormat\" & "\"
If MsgBox("Collect all sample files in the current dir:" & vbCrLf & fPath, vbYesNo) = vbYes Then
intFno = 0
fName = Dir(fPath & "*.xlsx")

While fName <> “”
  intFno = intFno + 1
  ReDim Preserve fList(1 To intFno)
  fList(intFno) = fName
  fName = Dir()
Wend

If intFno = 0 Then
  MsgBox "No files found"
  Exit Sub
End If
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For intFno = 1 To UBound(fList)
  On Error GoTo Skip
  Set wbOpened = Workbooks.Open(fPath & fList(intFno))
  With Sheets(1)
    For Each shape In ActiveSheet.Shapes
      If shape.Name = "Picture 19" Then
        shape.Delete
      End If
    Next shape
    Rows("84:84").Select
    ActiveSheet.Paste
  End With
  With Sheets(2)
    For Each shape In ActiveSheet.Shapes
      If shape.Name = "Picture 6" Then
        shape.Delete
      End If
    Next shape
    Rows("88:88").Select
    ActiveSheet.Paste
  End With
  Sheets(1).Select
  wbOpened.Save
wbOpened.Close False
Skip:
  Next
Else: End If

End Sub

Answers


Perhaps not the issue, but too long for a comment.

Your With blocks look funky - you're missing the leading period which ties the enclosed child items into the With object.

With Sheets(1)
  Rows("1:4").Select  '<< defaults to active sheet
  Selection.Copy
End With

should be:

With Sheets(1)
  .Rows("1:4").Select  '<< leading period ties this to Sheets(1)
  Selection.Copy
End With

Also:

fPath = “C:\NewFormat\” & “\”

Do you mean to terminate with two backslashes?


Need Your Help

Where does the GCC flag -Os come from on Mac OS X?

macos homebrew automake

I'm trying to install CurlPP, but it seems to put "-Os" in the CXXFLAGS. Then, it tries to remove the optimization flag, but the regex is -O[0-9] in automake doesn't match the 's'. This is causing ...

Implicit (bool) and == operator override - handle if statements correctly

c# operators override implicit

I have a custom class with implement both the == and the implicit for boolean operator.