locked
Accessing Windows Portable Devices (WPD) through Access 2010 VBA RRS feed

  • Question

  • I am trying to code a button in Access that will allow me to automatically transfer pictures and video from a digital camera to my hard drive.  After transferring, I want to automatically delete the pictures from the camera.  I have been unable to find any VBA code using WPD or the PortableDeviceAPI 1.0 Type Library.  Since portable devices do not resolve to drive letter, CopyFile or CopyFolder are not useable.  The system I am implementing this on contains both Win 7 Pro and XP Pro SP3 clients. 

    Can someone please assist me with getting this set up or point me to some examples?  The only thing I have found is C++ which does not work in Access.  Thanks!

    Jeff

     
    Monday, April 27, 2015 9:34 PM

All replies

  • Hi,

    This is the forum to discuss questions and feedback for Microsoft Excel, I'll move your question to the MSDN forum for VBA

    https://social.msdn.microsoft.com/Forums/en-US/home?category=vbajp&filter=alltypes%2Calllanguages&sort=lastpostdesc

    The reason why we recommend posting appropriately is you will get the most qualified pool of respondents, and other partners who read the forums regularly can either share their knowledge or learn from your interaction with us. Thank you for your understanding.

    George Zhao
    TechNet Community Support


    It's recommended to download and install Configuration Analyzer Tool (OffCAT), which is developed by Microsoft Support teams. Once the tool is installed, you can run it at any time to scan for hundreds of known issues in Office programs.

    Please remember to mark the replies as answers if they help, and unmark the answers if they provide no help. If you have feedback for TechNet Support, contact tnmff@microsoft.com.
    Tuesday, April 28, 2015 9:19 AM
  • did you ever find the solution?
    Sunday, March 20, 2016 3:32 PM
  • You may be able to use something like the following, which works for me in VBA 6.5 (Microsoft Office 2003). Of course you would need to call or incorporate this in a procedure for the button's click event.

    Private Sub Example_MoveFilesFromDevice()
    
        Dim oShell        As Object
        Dim oSourceFolder As Object
        Dim oTargetFolder As Object
        Dim oFile         As Object
        Dim r             As Long
        
        Const sTargetPath = "c:\temp\"
        Const sTargetFolder = "testfiles"
    
        Set oShell = CreateObject("Shell.Application")
        
        Set oTargetFolder = oShell.Namespace(sTargetPath).ParseName(sTargetFolder)
        If oTargetFolder Is Nothing Then
            MsgBox "Target folder not found.", vbCritical
            GoTo Out
        End If
        
        '     If the source path is a constant and you have the path:
        Const sSourceFolder = "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\\\?\usb#vid_054c&pid_04cb#10fbd475671683#{6ac27878-a6fa-4155-ba85-f98f491d4f33}\SID-{10001,00000000000000000000000005671683,7513636864}\{00000007-0000-0000-0000-000000000000}\{0000600F-0000-0000-139F-894D5E080200}"
        Set oSourceFolder = oShell.Namespace(sSourceFolder)
        '     Otherwise comment out the two lines above and use the following instead to browse
        '     The path obtained from the debug window can be pasted to a constant.
        ' Set oSourceFolder = oShell.BrowseForFolder(0, "Please select the folder.", 0, "")
        ' Debug.Print "Folder name: " & oSourceFolder.Title
        ' Debug.Print "Path: " & oSourceFolder.Self.Path
        
        If oSourceFolder Is Nothing Then
            MsgBox "Source folder not found.", vbCritical
            GoTo Out
        End If
        
        For Each oFile In oSourceFolder.Items
            
                oFile.InvokeVerb "Cut"
                oTargetFolder.InvokeVerb "Paste"
                
                r = r + 1
            
        Next oFile
        
        MsgBox r & " files processed.", vbInformation
        
    Out:
        
        Set oShell = Nothing
        Set oSourceFolder = Nothing
        Set oTargetFolder = Nothing
        Set oFile = Nothing
    End Sub
    Private Sub Example_CopyFilesToDevice()
    
        Dim oShell        As Object
        Dim oSourceFolder As Object
        Dim oTargetFolder As Object
        Dim oFile         As Object
        Dim r             As Long
        
        Const sSourcePath = "c:\temp\"
        Const sSourceFolder = "testfiles"
    
        Set oShell = CreateObject("Shell.Application")
        
        Set oSourceFolder = oShell.Namespace(sSourcePath & sSourceFolder)
        If oSourceFolder Is Nothing Then
            MsgBox "Source folder not found.", vbCritical
            GoTo Out
        End If
        
        '     If the target path is a constant and you have the path:
        Const sTargetFolder = "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\\\?\usb#vid_054c&pid_04cb#10fbd475671683#{6ac27878-a6fa-4155-ba85-f98f491d4f33}\SID-{10001,00000000000000000000000005671683,7513636864}\{00000007-0000-0000-0000-000000000000}\{0000600F-0000-0000-139F-894D5E080200}"
        Set oTargetFolder = oShell.Namespace(sTargetFolder)
        '     Otherwise comment out the two lines above and use the following instead to browse
        '     The path obtained from the debug window can be pasted to a constant.
        ' Set oTargetFolder = oShell.BrowseForFolder(0, "Please select the folder.", 0, "")
        ' Debug.Print "Folder name: " & oTargetFolder.Title
        ' Debug.Print "Path: " & oTargetFolder.Self.Path
        
        If oTargetFolder Is Nothing Then
            MsgBox "Target folder not found.", vbCritical
            GoTo Out
        End If
        
        For Each oFile In oSourceFolder.Items
                oTargetFolder.CopyHere oFile.Path
                r = r + 1
        Next oFile
        
        MsgBox r & " files processed.", vbInformation
        
    Out:
        Set oShell = Nothing
        Set oSourceFolder = Nothing
        Set oTargetFolder = Nothing
        Set oFile = Nothing
    End Sub




    • Edited by DaleThompson Thursday, June 16, 2016 9:21 PM Code improvement: cut & paste works after all
    • Proposed as answer by PTSDan Tuesday, July 17, 2018 4:14 PM
    Thursday, June 16, 2016 5:00 PM
  • It seems the MS broke the RAPI.DLL routines that a person could use from VBA sometime in the spring of 2018.

    You can connect, but 

    Public Declare Function CeFindFirstFile Lib "rapi.dll" (lpFileName As String, lpFindFileData As CE_FIND_DATA) As Long
    now returns -1 (INVALID_HANDLE_VALUE) no matter what I seem to do.

    That leaves folks who are using industrial equipment based on Pocket PC's in a bit of a pickle.

    Nicely enough, your code does work to suss out the constant for accessing the Pocket PC's files -- but it turns out that the debug.print lies a little.

    My IPAQ / CF Card / Documents would return something like 

    Path: ::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\\\?\activesyncwpdenumerator#umb#2&306b293b&0&hp-ipaq-hx2110pocketpcpocket-pc#{6ac27878-a6fa-4155-ba85-f98f491d4f33}\f%7CS%7C%5CCF%20Card%5C\f%7CF%7C%5CCF%20Card%5CDocuments%5C

    Replace this f%7CS%7C%5CCF%20Card%5C\f%7CF%7C%5CCF%20Card%5CDocuments%5C with CF Card\Documents to get

    Set oSourceFolder = oShell.Namespace("::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\\\?\activesyncwpdenumerator#umb#2&306b293b&0&hp-ipaq-hx2110pocketpcpocket-pc#{6ac27878-a6fa-4155-ba85-f98f491d4f33}\cf card\documents")

    and we're off to the races.

    Note that I have the WMDC installed on Windows 10 with the compatibility set for Vista SP2.

    Your mileage may vary -- but thanks for the source code pointing me in the right direction!

    I suspect that the same technique will work to get files off of iJunk devices as well

    My iPhone 6S DCIM folder returns as ::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\\\?\usb#vid_05ac&pid_12a8#19871adfb0cfdef3b7573b3e59e8af0e5670f323#{6ac27878-a6fa-4155-ba85-f98f491d4f33}\SID-{10001,Internal Storage,64000000000}\{00000001-0000-0000-0100-000000000000}

    Though it will not let me browse lower down than that


    Nick




    • Edited by Nick67 Wednesday, June 6, 2018 9:22 PM
    Wednesday, June 6, 2018 9:09 PM
  • Well done, Dale!
    Tuesday, July 17, 2018 4:14 PM