Airwolf
Board Regular
- Joined
- Jul 24, 2002
- Messages
- 123
I have the following code to select a FOLDER
Dim objFolder As Object, strPictFullPath As String, strFileName As String
Dim ws As Worksheet, wb As Workbook
Dim OldStaBar As Boolean
Dim ArrImg
Dim z As Integer
'// Define your image Formats here [Change as required]
ArrImg = Array("*.jpg") '("*.bmp", "*.gif", "*.jpg", "*.jpeg", "*.tif", "*.wmf")
Sheets("Photos").Select
'//
Set objFolder = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please Select Image Folder", 0, "")
If Not objFolder Is Nothing Then
'// Is it the Root Dir?...if so change
If Len(objFolder.Items.Item.Path) > 3 Then
strPictFullPath = objFolder.Items.Item.Path & Application.PathSeparator
Else
strPictFullPath = objFolder.Items.Item.Path
End If
Else
Exit Sub
End If
the routine goes on to embed all JPEG files into cells. I need to be able to select contiguous and non contiguous files rather than the whole folder contents.
Thanks
Dim objFolder As Object, strPictFullPath As String, strFileName As String
Dim ws As Worksheet, wb As Workbook
Dim OldStaBar As Boolean
Dim ArrImg
Dim z As Integer
'// Define your image Formats here [Change as required]
ArrImg = Array("*.jpg") '("*.bmp", "*.gif", "*.jpg", "*.jpeg", "*.tif", "*.wmf")
Sheets("Photos").Select
'//
Set objFolder = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please Select Image Folder", 0, "")
If Not objFolder Is Nothing Then
'// Is it the Root Dir?...if so change
If Len(objFolder.Items.Item.Path) > 3 Then
strPictFullPath = objFolder.Items.Item.Path & Application.PathSeparator
Else
strPictFullPath = objFolder.Items.Item.Path
End If
Else
Exit Sub
End If
the routine goes on to embed all JPEG files into cells. I need to be able to select contiguous and non contiguous files rather than the whole folder contents.
Thanks