Board logo

標題: [發問] 不固定的搜尋路徑 [打印本頁]
作者: man65boy    時間: 2015-11-25 14:10     標題: 不固定的搜尋路徑

若是"圖片資料夾"路徑，在不是很固定的路徑讀取的話，沒法執行檔案讀取，例如:有可會放在dropbox雲端，也有可能放在隨身硬碟或任何電腦的磁碟裡，要怎樣才能只讀取特定資料夾照片資料，不用給他正確的路徑，因為路徑會變來變去，唯一不變的是檔名"圖片的資料夾"，請老師們幫忙解題，謝謝!!!
附檔:[attach]22596[/attach]
Sub Ex()
    Dim xPath As String, xFile As String, Sp As Integer, Cz As Integer, G As Long, K As Integer, Mh As Integer
    Dim ii As Integer
    xPath = "D:\mydata\Desktop\新增資料夾 (2)\圖片資料夾\"                 '圖片的資料夾
    'Dir 函數 傳回一個 String ，用以表示合乎條件、檔案屬性、磁碟標記的一個檔案名稱、或目錄、檔案夾名稱。
    xFile = Dir(xPath & "*.jpg")            '圖片的副檔名 為jpg
    xFile = Dir(xPath & "*.*")             '圖片的資料夾 都是圖片檔
    With ActiveSheet                        '作用中的工作表
        Sp = 35   '水平
        Cz = 160  '垂直
        G = 0.1    '高
        K = 170     '寬
        Mh = 4     '每行
        .Pictures.Delete                    '刪除 所有圖片
        .[a:a] = ""                         '清除 A欄資料
        ii = 1                              '設定為1
        Application.ScreenUpdating = False
        Do
            .Cells(ii, 1).Select            '選擇A欄 的第 ii 儲存格(ActiveCell :作用中的儲存格)
            .Cells(ii, 1) = xFile           '寫上檔名
            With .Pictures.Insert(xPath & xFile)             '插入圖片
                .Left = ActiveCell.Offset(, 1).Left          '插入圖片的左端位置是: ActiveCell 右移2欄的左端
                .Top = ActiveCell.Offset(, 1).Top            '插入圖片的上端位置是: ActiveCell 右移2欄的上端
                .Width = 250                                 '設定 插入圖片的 寬度190
                .Height = 150                                '設定 插入圖片的 高度143
                ActiveCell.Offset(, 2).ColumnWidth = 30 '設定插入圖片所在儲存格 的寬
                ActiveCell.Offset(, 2).RowHeight = .Height    '設定插入圖片所在儲存格 的高
            End With
            xFile = Dir                     '繼續尋找下一個檔案
            ii = ii + 1                     'A欄 的第 ii 儲存格往下一列
        Loop Until xFile = ""               '離開 Do 迴圈的條件是: 找不到 檔案
        .[A1].Select
        Selection.EntireColumn.AutoFit      'AutoFit 方法 將範圍中的欄寬和列高調整為最適當的值
        Application.ScreenUpdating = True   'ScreenUpdating 屬性 定如果螢幕更新功能是開啟的則為 True。讀/寫 Boolean
    End With
   
   
End Sub
作者: GBKEE    時間: 2015-11-25 15:18

回復 1# man65boy

試試看
  1.   Dim ii As Integer
  2.     'xPath = "D:\mydata\Desktop\新增資料夾 (2)\圖片資料夾\"                 '圖片的資料夾
  3.     With Application.FileDialog(msoFileDialogFolderPicker)
  4.         If .Show = True Then
  5.             xPath = .SelectedItems(1) & "\"
  6.         Else
  7.             Exit Sub
  8.         End If
  9.     End With
複製代碼
  1. MsoFileDialogType 可以是這些 MsoFileDialogType 常數之一。
  2. msoFileDialogFilePicker  允許使用者選取檔案。
  3. msoFileDialogFolderPicker  允許使用者選取資料夾。
  4. msoFileDialogOpen  允許使用者開啟檔案。
  5. msoFileDialogSaveAs  允許使用者儲存檔案。
複製代碼
作者: man65boy    時間: 2015-11-25 20:12

回復 2# GBKEE

感謝GBKEE大師的解題，以這種方式是確實可以解決不固定的路徑，真多謝^^



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)