An excel macro that can be used to insert images stored in NetSuite cloud to an excel workbook.
Requirement for the macro:
Adding images to an excel workbook is a straightforward task in usual cases but files behave differently when NetSuite links are used. Files are usually accessed from file cabinet using the NetSuite file URL. A normal web browser can compile the file type by accessing and compiling the link data but excel had difficulties recognizing these NetSuite specific links since the links does not have the correct data type specified. The files downloaded were in ‘.nl’ format.
Function of the macro code:
Written in: VBA
Purpose: The code when applied/run in a workbook takes in NetSuite image links from a specified column and downloads the files to a local storage location. The macro then inserts the images back to the specified column in the workbook by renaming the file type to ‘.JPG format (or any other format, please edit the code and ensure file type is valid) for excel to recognize the images inserted. All of the columns and location/image dump for the files can be edited in the code, please refer to the commented portion.
Two versions of code attached, one fills the images to the dimensions of the cell (thus stretching out the images which may or may not be ideal for the requirement), the second one fits the images to the cell regardless of the cell size, the images will be resized to fit the cell.
Code to fill image:
Option Explicit
#If VBA7 And Win64 Then
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" ( _
ByVal pCaller As LongPtr, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As LongPtr, _
ByVal lpfnCB As LongPtr _
) As Long
#Else
Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" ( _
ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long _
) As Long
#End If
Function createFolder() As String
If Len(Dir("E:\Workspace\Temp", vbDirectory)) = 0 Then '<~~ specify the directory for image dump
MkDir "E:\Workspace\Temp"
End If
createFolder = "E:\Workspace\Temp\"
End Function
Function createColumn() As String
Dim Column As Range: Set Column = Application.Range("F:F")
Column.Insert Shift:=xlShiftToRight, CopyOrigin:=xlFormatFromRightOrBelow
Range("F3").Value = "Product image"
End Function
Function DownloadFile(URL As String, LocalFilename As String) As Boolean
Dim lngRetVal As Long
lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
If lngRetVal = 0 Then DownloadFile = True
End Function
Sub DownloadPics()
Dim ws As Worksheet
Dim LastRow As Long, i As Long
Dim strPath As String
Dim FolderName As String
Dim Ret As Long
Dim c As String
c = createColumn()
Application.ScreenUpdating = False
FolderName = createFolder()
Set ws = Sheets("Sheet1") '~~> Name of the sheet which has the list
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow '<~~ loop to download and rename to JPEG
strPath = FolderName & ws.Range("A" & i).Value & ".jpg" '<~~ column A used for reference/ID for the images
Ret = URLDownloadToFile(0, ws.Range("E" & i).Value, strPath, 0, 0)
If Ret = 0 Then '<~~ Used to check the download status,change the column/ delete IF statement, upto the user
ws.Range("X" & i).Value = "File successfully downloaded"
Else
ws.Range("X" & i).Value = "Unable to download the file"
End If
Next i
Range("X3").Value = "Download stats"
Dim fPath As String, fName As String
Dim r As Range, rng As Range
Dim shpPic As Shape
fPath = FolderName
Set rng = Range("A3:A" & Cells(Rows.Count, 4).End(xlUp).Row) '<~~ column A used for reference/ID for the images
For Each r In rng
On Error GoTo errHandler
If r.Value <> "" Then '<~~ loop to insert image back into the sheet
Set shpPic = ActiveSheet.Shapes.AddPicture(Filename:=fPath & r.Value & ".jpg", linktofile:=msoFalse, _
savewithdocument:=msoTrue, Left:=Cells(r.Row, 6).Left, Top:=Cells(r.Row, 6).Top, Width:=-1, Height:=-1)
With shpPic
.LockAspectRatio = msoTrue
If .Width > Columns(5).Width Then .Width = Columns(5).Width
Rows(r.Row).RowHeight = .Height
End With
End If
Dim strJPGLink As String
Dim strJPGFile As String
Dim Result As Boolean
strJPGLink = ActiveSheet.Range("A1").Value
strJPGFile = FolderName & "ennekolle" & ".jpg"
Result = DownloadFile(strJPGLink, strJPGFile)
Sheets("Sheet1").Range("A1").ClearContents
Dim PicPath As String, Pic As Picture, ImageCell As Range
PicPath = strJPGFile
Set ImageCell = Range("A1")
Set Pic = ActiveSheet.Pictures.Insert(PicPath)
With Pic
.ShapeRange.LockAspectRatio = msoFalse
.Left = ImageCell.Left
.Top = ImageCell.Top
.Width = ImageCell.Width
.Height = ImageCell.Height
End With
errHandler:
If Err.Number <> 0 Then
Debug.Print Err.Number & ", " & Err.Description & ", " & r.Value
On Error GoTo -1
End If
Next r
Application.ScreenUpdating = True
End SubCode to fit image:
Option Explicit
#If VBA7 And Win64 Then
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" ( _
ByVal pCaller As LongPtr, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As LongPtr, _
ByVal lpfnCB As LongPtr _
) As Long
#Else
Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" ( _
ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long _
) As Long
#End If
Function createFolder() As String
If Len(Dir("E:\Workspace\Temp", vbDirectory)) = 0 Then '<~~ specify the directory for image dump
MkDir "E:\Workspace\Temp"
End If
createFolder = "E:\Workspace\Temp\"
End Function
Function createColumn() As String
Dim Column As Range: Set Column = Application.Range("F:F")
Column.Insert Shift:=xlShiftToRight, CopyOrigin:=xlFormatFromRightOrBelow
Range("F3").Value = "Product image"
End Function
Function DownloadFile(URL As String, LocalFilename As String) As Boolean
Dim lngRetVal As Long
lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
If lngRetVal = 0 Then DownloadFile = True
End Function
Sub DownloadPics()
Dim ws As Worksheet
Dim LastRow As Long, i As Long
Dim strPath As String
Dim FolderName As String
Dim Ret As Long
Dim c As String
c = createColumn()
Application.ScreenUpdating = False
FolderName = createFolder()
Set ws = Sheets("Sheet1") '~~> Name of the sheet which has the list
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow '<~~ loop to download and rename to JPEG
strPath = FolderName & ws.Range("A" & i).Value & ".jpg" '<~~ column A used for reference/ID for the images
Ret = URLDownloadToFile(0, ws.Range("E" & i).Value, strPath, 0, 0)
If Ret = 0 Then '<~~ Used to check the download status,change the column/ delete IF statement, upto the user
ws.Range("X" & i).Value = "File successfully downloaded"
Else
ws.Range("X" & i).Value = "Unable to download the file"
End If
Next i
Range("X3").Value = "Download stats"
Dim fPath As String, fName As String
Dim r As Range, rng As Range
Dim shpPic As Shape
fPath = FolderName
Set rng = Range("A3:A" & Cells(Rows.Count, 4).End(xlUp).Row) '<~~ column A used for reference/ID for the images
For Each r In rng
On Error GoTo errHandler
If r.Value <> "" Then '<~~ loop to insert image back into the sheet
Set shpPic = ActiveSheet.Shapes.AddPicture(Filename:=fPath & r.Value & ".jpg", linktofile:=msoFalse, _
savewithdocument:=msoTrue, Left:=Cells(r.Row, 6).Left, Top:=Cells(r.Row, 6).Top, Width:=-1, Height:=-1)
With shpPic
.LockAspectRatio = msoTrue
If .Width > Columns(5).Width Then .Width = Columns(5).Width
Rows(r.Row).RowHeight = .Height
End With
End If
Dim strJPGLink As String
Dim strJPGFile As String
Dim Result As Boolean
strJPGLink = ActiveSheet.Range("A1").Value
strJPGFile = FolderName & "ennekolle" & ".jpg"
Result = DownloadFile(strJPGLink, strJPGFile)
Sheets("Sheet1").Range("A1").ClearContents
Dim PicPath As String, Pic As Picture, ImageCell As Range
PicPath = strJPGFile
Set ImageCell = Range("A1")
Set Pic = ActiveSheet.Pictures.Insert(PicPath)
With Pic
Pic.Left = ImageCell.MergeArea.Left
Pic.Top = ImageCell.MergeArea.Top
If Pic.Width > ImageCell.MergeArea.Width Then Pic.Width = ImageCell.MergeArea.Width
If Pic.Height > ImageCell.MergeArea.Height Then Pic.Height = ImageCell.MergeArea.Height
'Center
If Pic.Width < ImageCell.MergeArea.Width Then Pic.Left = ImageCell.MergeArea.Left + (ImageCell.MergeArea.Width - Pic.Width) / 2
If Pic.Height < ImageCell.MergeArea.Height Then Pic.Top = ImageCell.MergeArea.Top + (ImageCell.MergeArea.Height - Pic.Height) / 2
End With
errHandler:
If Err.Number <> 0 Then
Debug.Print Err.Number & ", " & Err.Description & ", " & r.Value
On Error GoTo -1
End If
Next r
Application.ScreenUpdating = True
End Sub