I have a macro that, from a chosen folder, input and resize all images inside a word document.
When we choose a folder from a laptop's drive, the macro works well.
However, when we choose a folder stored inside a network (company's network), images aren't insert in the good order.
I would like to display images exactly how they are stored inside the folder: by name order.
As any one have an idea how to fix this problem?
Here is my macro:
Attribute VB_Name = "InsertImagesAnnexes"
Option Explicit
Sub InsertImagesAnnexes()
Dim FolderPath, objFSO, Folder, ImagePath, image, countphoto As Integer
Const END_OF_STORY = 6
Const MOVE_SELECTION = 0
countphoto = 0
FolderPath = Select_Folder_From_Prompt
If InStr(FolderPath, "EMPTY") = 0 Then
Set objFSO = CreateObject("Scripting.Filesystemobject")
Set Folder = objFSO.GetFolder(FolderPath)
For Each image In Folder.Files
ImagePath = image.Path
If CheckiImageExtension(ImagePath) = True Then
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Selection.Font.Name = "Times New Roman"
Selection.Font.Size = "12"
If countphoto = 0 Then
Application.Selection.InsertBreak 'Insert a pagebreak
Selection.TypeText Text:="ANNEXES PHOTOGRAPHIQUES" & Chr(11) & Chr(11)
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Else
Application.Selection.EndKey END_OF_STORY, MOVE_SELECTION
Application.Selection.InlineShapes.AddPicture (ImagePath)
Selection.TypeText Text:=Chr(11) & Chr(11) & "PHOTO N°" & countphoto & Chr(11) & Chr(11) & Chr(11)
End If
countphoto = countphoto + 1
End If
Next
End If
End Sub
Function Select_Folder_From_Prompt() As String
Dim fd, bMultiSelect, CONST_MODEL_DIRECTORY
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.Title = "Select a folder"
.AllowMultiSelect = bMultiSelect
.InitialFileName = CONST_MODEL_DIRECTORY
.Filters.Clear
'Use the Show method to display the File Picker dialog box and return the user's action.
'The user pressed the action button.
If .Show = -1 Then
Select_Folder_From_Prompt = .SelectedItems(1) & "\"
Else
Select_Folder_From_Prompt = "EMPTY"
End If
End With
End Function
Function CheckiImageExtension(ImagePath)
Dim varArray ' An array contains iamge file extensions.
Dim varEach ' Each iamge file extension.
Dim blnIsPptFile ' Whether the file extension is image file extension.
Dim objFSO, file, FileExtension
Set objFSO = CreateObject("Scripting.Filesystemobject")
Set file = objFSO.GetFile(ImagePath)
FileExtension = file.Name
blnIsPptFile = False
If FileExtension <> "" Then
varArray = Array(".emf", ".wmf", ".jpg", ".jpeg", ".jfif", ".png", ".jpe", ".bmp", ".dib", ".rle", ".gif", ".emz", ".wmz", ".pcz", ".tif", ".tiff", ".eps", ".pct", ".pict", ".wpg")
For Each varEach In varArray
If InStrRev(UCase(FileExtension), UCase(varEach)) <> 0 Then
blnIsPptFile = True
Exit For
End If
Next
End If
CheckiImageExtension = blnIsPptFile
Set objFSO = Nothing
Set file = Nothing
End Function