Inserting Screenshots to Excel Sheet using VBA

Hi all,

the requirement is to add all the Screenshot present in a folder one by one to Excel sheet one after the other.

I am looping the folder and getting Screenshots and using Invoke code placing all into Excel sheet.

But the problem is the code I’m using is opening excel and pasting and closing excel for every image.I want the excel to be opened once and then insert all the image one after the other.I’m not good in vb code,can anyone please modify or guide me to do so.

Have attached the code screenshot
Capture

and below is the code

  1. filename =the path of the Excel file
  2. Sheetname=the excel sheet name
  3. Image path = Path of the image
    4.CellReference= Cell value

Dim excel_raw As Microsoft.Office.Interop.Excel.Application
Dim wb_c As Microsoft.Office.Interop.Excel.Workbook
Dim ws As Microsoft.Office.Interop.Excel.Worksheet

excel_raw=New Microsoft.Office.Interop.Excel.ApplicationClass
excel_raw.DisplayAlerts=False

excel_raw.Visible=True

wb_c=excel_raw.Workbooks.Open(filename)
ws=CType(wb_c.Sheets(sheetname),Microsoft.Office.Interop.Excel.Worksheet)
ws.Activate

Dim oRange As Microsoft.Office.Interop.Excel.Range=ws.Range(CellReference)
Dim left As Single=convert.ToSingle(oRange.Left)
Dim top As Single=convert.ToSingle(oRange.top)

Dim s As Microsoft.Office.Interop.Excel.Shape=ws.shapes.AddPicture(ImagePath,Microsoft.Office.Core.MsoTriState.msoFalse,Microsoft.Office.Core.MsoTriState.msoTrue,Left,top,500,420)

ws.Range(“A:Z”).Columns.AutoFit()
wb_c.Save()
excel_raw.Quit()

1 Like

Hi @yashashwini2322

Try this

Regards,

1 Like

Hi @yashashwini2322 ,

Could you try iterating through the images within the invoke code itself?
That should help get the job done:

Dim excel_raw As Microsoft.Office.Interop.Excel.Application
Dim wb_c As Microsoft.Office.Interop.Excel.Workbook
Dim ws As Microsoft.Office.Interop.Excel.Worksheet

    excel_raw=New Microsoft.Office.Interop.Excel.ApplicationClass
    excel_raw.DisplayAlerts=False

    excel_raw.Visible=True

    wb_c=excel_raw.Workbooks.Open(filename)
    ws=CType(wb_c.Sheets(sheetname),Microsoft.Office.Interop.Excel.Worksheet)
    ws.Activate
    For Each file As string In Directory.GetFiles("folderPathGoesHere")     
            'Checking if screenshot exists, and if not skip to the next iteration
            If Not System.IO.File.Exists(item.ToString) Then
                Console.WriteLine("File '"+System.IO.Path.GetFileNameWithoutExtension(item.ToString)+"' does not exist.")
                Continue For
            End If
    Dim oRange As Microsoft.Office.Interop.Excel.Range=ws.Range(CellReference)
    Dim left As Single=convert.ToSingle(oRange.Left)
    Dim top As Single=convert.ToSingle(oRange.top)

    Dim s As Microsoft.Office.Interop.Excel.Shape=ws.shapes.AddPicture(item.ToString,Microsoft.Office.Core.MsoTriState.msoFalse,Microsoft.Office.Core.MsoTriState.msoTrue,Left,top,500,420)
    Next item
    ws.Range(“A:Z”).Columns.AutoFit()
wb_c.Save()
excel_raw.Quit()

Kind Regards,
Ashwin A.K