Results 1 to 9 of 9
  1. #1
    5 Star Lounger
    Join Date
    Jan 2004
    Location
    Praha
    Posts
    988
    Thanks
    56
    Thanked 105 Times in 90 Posts

    Opening folder to paste image

    I'd like to write a macro to paste an image but, rather than paste a specific image, to leave me with a specific folder open in the dialog box so I can choose the target image file at the time.

    I've recorded this code:

    ChangeFileOpenDirectory _
    "C:. . . folder path"
    Selection.InlineShapes.AddPicture FileName:= _
    "C:. . . image path" _
    , LinkToFile:=False, SaveWithDocument:=True
    How can I adapt it to stop before an image file is selected ?

    Thanks
    Last edited by MartinM; 2015-05-16 at 10:32.

  2. #2
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,433
    Thanks
    371
    Thanked 1,456 Times in 1,325 Posts
    Martin,

    Here are some Windows API Functions that should get you what you want:
    Code:
    Option Explicit
    
    '                        +--------------------------+            +----------+
    '------------------------|Windows Function Type Defs|------------| 08/11/05 |
    '                        +--------------------------+            +----------+
    Public Type BROWSEINFO
        hOwner As Long
        pidlRoot As Long
        pszDisplayName As String
        lpszTitle As String
        ulFlags As Long
        lpfn As Long
        lParam As Long
        iImage As Long
    End Type
    
    '                     +-----------------------------+            +----------+
    '---------------------|Windows Function Declarations|------------| 08/11/05 |
    '                     +-----------------------------+            +----------+
    Declare Function SHGetPathFromIDList Lib "shell32.dll" _
      Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
                                    ByVal pszPath As String) As Long
                                    
    Declare Function SHBrowseForFolder Lib "shell32.dll" _
    Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
    
    '                         +-------------------------+            +----------+
    '-------------------------|     zGetDirectory()     |------------| 07/25/05 |
    '                         +-------------------------+            +----------+
    'Calls: N/A
    'Notes: This function will bring up a form to let the user select a directory
    
    Public Function zGetDirectory(Optional Msg) As String
    
        Dim bInfo As BROWSEINFO
        Dim zPath As String
        Dim lRetVal2 As Long, lRetVal As Long, iEndOfStr As Integer
    
        bInfo.pidlRoot = 0  '*** Root folder = Desktop ***
    
    '***   Title in the dialog ***
        If IsMissing(Msg) Then
            bInfo.lpszTitle = "Select a Drive/Directory."
        Else
            bInfo.lpszTitle = Msg
        End If
    
        bInfo.ulFlags = &H1  '*** Type of directory to return ***
        lRetVal = SHBrowseForFolder(bInfo)  '*** Display the dialog ***
        zPath = Space$(512)     '*** Parse the result ***
        lRetVal2 = SHGetPathFromIDList(ByVal lRetVal, ByVal zPath)
        If lRetVal2 Then
            iEndOfStr = InStr(zPath, Chr$(0))
            zGetDirectory = Left(zPath, iEndOfStr - 1)
        Else
            zGetDirectory = ""
        End If
        
    End Function             'zGetDirectory(Optional Msg)
    
    '                        +--------------------+                 +----------+
    '------------------------|   zGetFileName     |-----------------| 02/22/15 |
    '                        +--------------------+                 +----------+
    
    Public Function zGetFileName(Optional vInitialDir As Variant) As String
    
    'Note: This function can be called directly passing the initial directory
    '      or you can call the zGetDirectory function first to obtain the
    '      initial directory or call w/o argument to use the current directory
    '      as the starting point.
     
        Dim lngCount  As Long
        Dim dlgMyFile As FileDialog
        
        Set dlgMyFile = Application.FileDialog(msoFileDialogOpen)
           
        With dlgMyFile
        
            .AllowMultiSelect = False
            .InitialView = msoFileDialogViewDetails
            .FilterIndex = 2   'Excel Files excludes csv, xla, xhtml, etc.
    '*** Note: if the InitialFileName is a Directory it should be followed by an
    '***       ending \ to prevent the dir name showing up in the file name box.
            .InitialFileName = vInitialDir
            .Show
     
            If .SelectedItems.Count <> 0 Then _
              zGetFileName = .SelectedItems(1)
     
        End With
        
        Set dlgMyFile = Nothing
        
    End Function   'zGetFileName()
    Here's some test calling code:
    Code:
    Option Explicit
    
    Sub SelectedFile()
    
       Dim zDirectory  As String
       Dim zFileName   As String
       Dim zSaveDir    As String
       
       zSaveDir = CurDir()
       
       zDirectory = zGetDirectory("Select Directory/Folder:")
      
       If Len(zDirectory) > 0 Then
          zFileName = zGetFileName(zDirectory & "\")
          MsgBox zFileName, vbOKOnly + vbInformation, _
                 "The Select File is:"
          ChDir zSaveDir
       Else
          MsgBox "No Directory Selected!", vbOKOnly + vbCritical, _
                 "User CANCELLED!"
       End If
       
    End Sub
    Note this is Excel tested code but should work in Word just fine. The trick is to get your filename before you start your code to do the insert. You'll note that the ZfileName variable above has the fully qualified d:/path/fn for use in your insert image command.

    HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  3. #3
    5 Star Lounger
    Join Date
    Jan 2004
    Location
    Praha
    Posts
    988
    Thanks
    56
    Thanked 105 Times in 90 Posts
    Thanks - lots of ideas !!
    I wanted to open the directory to be able to browse the images - I'll have no idea of the filename hence wanting to "see before I paste".
    This is dead easy to do "manually" and I hadn't expected it to be so hard in VBA.
    Working on adapting your code though - thank you.

  4. #4
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,433
    Thanks
    371
    Thanked 1,456 Times in 1,325 Posts
    Martin,

    You can change the setting: .FilterIndex to 1. This will get you All files.
    You can change the setting: .InitialView to one of these values:
    msoFileDialogViewLargeIcons
    msoFileDialogViewSmallIcons
    msoFileDialogViewTiles
    msoFileDialogViewThumbnail

    However, I have been unsuccessful in setting this value and getting a different display as it seems it remembers the last setting and uses it. That said, once the file display is up you can use the view button to change it to whatever setting you want:
    martin.JPG

    HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  5. The Following User Says Thank You to RetiredGeek For This Useful Post:

    MartinM (2015-05-16)

  6. #5
    5 Star Lounger
    Join Date
    Jan 2004
    Location
    Praha
    Posts
    988
    Thanks
    56
    Thanked 105 Times in 90 Posts
    Got it, and there's your thousandth "thank you"

  7. #6
    Super Moderator
    Join Date
    Jan 2001
    Location
    Melbourne, Victoria, Australia
    Posts
    3,852
    Thanks
    4
    Thanked 259 Times in 239 Posts
    If you wanted to avoid all the API calls you could summon the dialog more directly with...
    Code:
    Sub GoFetch()
      Dim strPictPath As String
      
      'Save user's original path
      strPictPath = Options.DefaultFilePath(Path:=wdPicturesPath)
      
      'Change path to directory of your pictures
      Options.DefaultFilePath(Path:=wdPicturesPath) = "D:\Work\My Photos"
      
      'Display the dialog
      With Dialogs(wdDialogInsertPicture)
        .Show
      End With
      
      'Before quitting, restore user's original path
      Options.DefaultFilePath(Path:=wdPicturesPath) = strPictPath
    End Sub
    Andrew Lockton, Chrysalis Design, Melbourne Australia

  8. The Following 2 Users Say Thank You to Andrew Lockton For This Useful Post:

    MartinM (2015-05-17),RetiredGeek (2015-05-17)

  9. #7
    5 Star Lounger
    Join Date
    Jan 2004
    Location
    Praha
    Posts
    988
    Thanks
    56
    Thanked 105 Times in 90 Posts
    RG - I had just got your code to do what I wanted when Andrew came up with this very compact alternative.

    Nice to have options - I'm going with Andrew on this occasion, not least because I understand it more easily !

    Thanks both.

    I'll be in Melbourne in October so I can bring any outstanding queries in person

  10. #8
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,433
    Thanks
    371
    Thanked 1,456 Times in 1,325 Posts
    Andy,

    Very Nice!
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  11. #9
    Super Moderator
    Join Date
    Jan 2001
    Location
    Melbourne, Victoria, Australia
    Posts
    3,852
    Thanks
    4
    Thanked 259 Times in 239 Posts
    Well the warm weather should have just about returned by then so you might even enjoy it here when you get to Melbourne.
    Andrew Lockton, Chrysalis Design, Melbourne Australia

  12. The Following User Says Thank You to Andrew Lockton For This Useful Post:

    MartinM (2015-05-19)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •