mougにあった質問関連のメモです。

ポータブル デバイスからファイルをコピーする手段として、「Copy/Move Files from Portable Device」ではShellオブジェクトが使われていました。

※ Copy/Move Files from Portable DeviceのコードをVBA向けに直したものが下記になります。

Option Explicit

Public Sub GetFolderPath()
  Dim fol As Object
  
  With CreateObject("Shell.Application")
    Set fol = .BrowseForFolder(0, "ポータブル デバイス上のフォルダーを選択してください。", 0, "")
    If fol Is Nothing Then Exit Sub
    Debug.Print fol.Self.Path
  End With
End Sub

Public Sub CopyItems()
  Dim srcFol As Object, dstFol As Object
  Dim itm As Object
  Const srcFolPath As String = "::{20D04FE0-…" 'GetFolderPathプロシージャーで取得したポータブル デバイス上のフォルダーのパス
  Const dstFolPath As String = "C:\Test" 'コピー先フォルダーのパス
  
  With CreateObject("Shell.Application")
    Set srcFol = .Namespace(srcFolPath)
    Set dstFol = .Namespace(dstFolPath)
    For Each itm In srcFol.Items
      dstFol.CopyHere itm
    Next
  End With
  Debug.Print "処理が終了しました。"
End Sub

BrowseForFolderでポータブル デバイス上のフォルダーのパスを取得して、CopyHereでファイルのコピーを行う形ですが、いちいちフォルダーを選択するのは面倒なので、フォルダーを選択する部分を端折った処理を考えてみました。

Option Explicit

Public Sub Sample()
  CopyPDItems "コンピューター\(機種名)\SDカード\DCIM\100MEDIA", "C:\Test"
  MsgBox "処理が終了しました。", vbInformation + vbSystemModal
End Sub

Private Sub CopyPDItems(ByVal SrcFolderPath As String, ByVal DstFolderPath As Variant)
'ポータブル デバイスにあるフォルダーの中身を指定したフォルダーにコピーする
' - SrcFolderPath:コピー元フォルダーのパス(ポータブル デバイス)
' - DstFolderPath:コピー先フォルダーのパス

  Dim PDFolderPath As Variant
  Dim ParentFolderPath As Variant
  Dim SrcFolder As Object, DstFolder As Object
  Dim itm As Object
  Dim v As Variant
  Dim i As Long, num As Long
  
  PDFolderPath = "": ParentFolderPath = "" '初期化
  If Right(SrcFolderPath, 1) = ChrW(&H5C) Then SrcFolderPath = Left(SrcFolderPath, Len(SrcFolderPath) - 1) '右端のパスセパレーター除去
  v = Split(SrcFolderPath, ChrW(&H5C))
  If v(0) = "コンピューター" Then 'パス最初の「コンピューター」は無視する
    num = 1
  Else
    num = LBound(v)
  End If
  For i = num To UBound(v)
    PDFolderPath = GetPDFolderPath(ParentFolderPath, v(i))
    If Len(PDFolderPath) < 1 Then
      MsgBox "フォルダーが見つかりません。" & vbCrLf & "処理を中止します。", vbCritical + vbSystemModal
      Exit Sub
    End If
    ParentFolderPath = PDFolderPath
  Next
  With CreateObject("Shell.Application")
    Set SrcFolder = .Namespace(PDFolderPath)
    Set DstFolder = .Namespace(DstFolderPath)
    If SrcFolder Is Nothing Or DstFolder Is Nothing Then
      MsgBox "フォルダーが見つかりません。" & vbCrLf & "処理を中止します。", vbCritical + vbSystemModal
      Exit Sub
    End If
    On Error Resume Next
    For Each itm In SrcFolder.Items
      DstFolder.CopyHere itm 'フォルダー含めてコピー
    Next
    If Err.Number <> 0 Then MsgBox "エラーが発生しました。" & vbCrLf & vbCrLf & "エラー番号:" & Err.Number & vbCrLf & "エラー内容:" & Err.Description, vbCritical + vbSystemModal
    On Error GoTo 0
  End With
End Sub

Private Function GetPDFolderPath(ByVal ParentFolderPath As Variant, ByVal FolderName As String) As String
  Dim ret As String
  Dim fol As Object
  Dim itm As Object
  
  ret = "": Set fol = Nothing '初期化
  With CreateObject("Shell.Application")
    Set fol = .Namespace(ParentFolderPath)
    If Not fol Is Nothing Then
      For Each itm In fol.Items
        If itm.Name = FolderName Then
          ret = itm.Path
          Exit For
        End If
      Next
    End If
  End With
  GetPDFolderPath = ret
End Function

上記コードでは「コンピューター\(機種名)\SDカード\DCIM\100MEDIA」のような形でポータブル デバイス上のフォルダーのパスを指定しています。
エラーの処理等大雑把に書いてありますが、一応手元のスマートフォンで動作確認できました。