PDA

View Full Version : How to sort files before inserting to worksheet



gincemathew
02-13-2013, 02:19 AM
I am using a macro to insert picture from subfolders to worksheet.Picture name is in the order 0,10,30,60,90,120,150,180,210,240,270,300,330 etc....
Now its inserting picture in the order

0 10
120 150
180 210
240 270
300 30
330 60
90

But The output i required is

0 10
30 60
90 120
150 180
210 240
270 300
330

Pls help..

Code i am using is....

Option Explicit

Private fso As Object
Private fsoRoot As Object
Private fsoFolder As Object
Private fsoFile As Object

Const strRootFolder As String = "C:\Pictures"

'########################################################################## ############################################# #####
'########################################################################## ############################################# #####
Public Sub MainLine()

Set fso = CreateObject("Scripting.FileSystemObject")
Set fsoRoot = fso.GetFolder(strRootFolder)

Application.ScreenUpdating = False

Call libProcessFolder(fsoRoot)

Application.ScreenUpdating = False

End Sub

'########################################################################## ############################################# #####
'########################################################################## ############################################# #####

Private Sub libProcessFolder(ByRef prmFolder As Object)
On Error Resume Next

Dim wbkPictures As Excel.Workbook
Dim xlsPictures As Excel.Worksheet
Dim lngRowNumber As Long
Dim strColumnName As String

lngRowNumber = -8
strColumnName = "A"

'#
'# first process all objects with the folder received and when valid jpg files are found, create a new
'# workbook instance and start inserting pictures on the first worksheet
'#
For Each fsoFile In prmFolder.Files
If fsoFile.Name Like "*.jpg" Then

'# create a workbook object if not yet opened
If lngRowNumber < 0 Then
Set wbkPictures = Application.Workbooks.Add
Set xlsPictures = wbkPictures.Worksheets(1)
lngRowNumber = lngRowNumber + 10
End If

'# insert the picture
With xlsPictures.Pictures.Insert(fsoFile.Path)
.Left = xlsPictures.Cells(lngRowNumber, strColumnName).Left
.Top = xlsPictures.Cells(lngRowNumber, strColumnName).Top
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 125#
.ShapeRange.Width = 150#
.ShapeRange.Rotation = 0#
End With

'# insert the picture name one row above the picture
xlsPictures.Cells(lngRowNumber - 1, strColumnName).Value = Split(fsoFile.Name, ".")(0)

'# set the location for the next picture
If strColumnName = "A" Then
strColumnName = "F"
Else
strColumnName = "A"
lngRowNumber = lngRowNumber + 10
End If

End If
Next fsoFile

'#
'# if pictures were found, the workbook created is to be saved using the name of the folder
'#
If lngRowNumber > 0 Then
wbkPictures.SaveAs strRootFolder & "\" & prmFolder.Name & ".xls"
wbkPictures.Close
End If

'#
'# repeat the process for any subfolders found
'#
For Each fsoFolder In prmFolder.SubFolders
Call libProcessFolder(fsoFolder)
Next fsoFolder

End Sub

Crocus Crow
02-22-2013, 03:58 PM
Put the file names in an array or sheet column, sort them (VBA Sort function or write your own or copy one from the web), then insert based on the sorted image name.