[發問] 指定主資料夾,將其副資料夾一一載入各sheet(含改name)(已解決,感謝)

cmo140497

Dear 各位版主 :
小弟用vba寫將指定之資料夾內之圖片一一載入至指定欄位,但如果主資料夾內之副資料夾太多,得一個一個開啟-載入-移動sheet,不知如何可一次開啟
程式,指定主資料夾,將其副資料夾一一載入各sheet(含改name),及載入圖片,謝謝!

GBKEE

回復 1# cmo140497
試試看

1. Sub Ex()
   
2.     Dim Fs As Object, E, i As Integer, P, ii As Integer
   
3.     With CreateObject("Scripting.FileSystemObject").GetFolder("d:\相片\") '<-修改為你要查詢之資料夾
   
4.         i = 1
   
5.         For Each E In .SubFolders
   
6.             If i > ActiveWorkbook.Sheets.Count Then
   
7.                 Sheets.Add(, Sheets(Sheets.Count)).Name = E.Name
   
8.             Else
   
9.                 Sheets(i).Name = E.Name
   
10.             End If
    
11.             ii = 1
    
12.             For Each P In E.Files
    
13.               If InStr(UCase(P.Name), ".JPG") Then
    
14.                 With Sheets(i).Pictures.Insert(P)
    
15.                     .Top = Cells(ii, 2).Top
    
16.                     .Left = Cells(ii, 2).Left
    
17.                     .Width = 50
    
18.                     .Height = 50
    
19.                 End With
    
20.                 ii = ii + 5
    
21.             End If
    
22.         Next
    
23.             i = i + 1
    
24.         Next
    
25.     End With
    
26. End Sub

複製代碼

cmo140497

版主實在太神了,一次就解決我的困擾,另請教版主
InStr 函數   傳回在某字串中一字串的最先出現位置，此位置為 Variant (Long)。
Ucase 函數 傳回一個 Variant (String)，所含為轉成大寫之字串
可否請版主幫小弟解釋一下這些函數的用意
另如果可以用Application.FileDialog(msoFileDialogFolderPicker)來指定資料夾的話,要如何寫這段程式?
及將圖片檔案名稱並行載入另一欄位,不知是否可行?

GBKEE

回復 3# cmo140497
If InStr(UCase(P.Name), ".JPG")  Then -> If InStr(UCase(P.Name), ".JPG")=True  Then
P.Name 在此程式中->依序傳回每一資料夾中的File的名稱
InStr的比對是有分大小寫的,如InStr有比對到時>0   系統將>0的數值轉換成 True
試試看

1. Sub Ex()
   
2.     Dim Fs As Object, E, i As Integer, P, ii As Integer
   
3.     Dim xlPath As String
   
4.     With Application.FileDialog(msoFileDialogFolderPicker)
   
5.         .AllowMultiSelect = False    'True 如果允許使用者從檔案對話方塊選取多個檔案
   
6.         .Show
   
7.         If .SelectedItems.Count = 0 Then Exit Sub
   
8.         xlPath = .SelectedItems(1)
   
9.     End With
   
10.     With CreateObject("Scripting.FileSystemObject").GetFolder(xlPath)
    
11.         i = 1
    
12.         For Each E In .SubFolders
    
13.             If i > ActiveWorkbook.Sheets.Count Then
    
14.                 Sheets.Add(, Sheets(Sheets.Count)).Name = E.Name
    
15.             Else
    
16.                 Sheets(i).Name = E.Name
    
17.             End If
    
18.             ii = 1
    
19.             For Each P In E.Files
    
20.               If InStr(UCase(P.Name), ".JPG") Then
    
21.                 With Sheets(i).Pictures.Insert(P)
    
22.                     .Top = Cells(ii, 2).Top
    
23.                     .Left = Cells(ii, 2).Left
    
24.                     .Width = 50
    
25.                     .Height = 50
    
26.                 End With
    
27.                 ii = ii + 5
    
28.             End If
    
29.         Next
    
30.             i = i + 1
    
31.         Next
    
32.     End With
    
33. End Sub

複製代碼

cmo140497

Dear 版主 :
實在太感謝版主了,小弟還是有一疑惑
InStr 函數   傳回在某字串中一字串的最先出現位置，此位置為 Variant (Long)。
If InStr(UCase(P.Name), ".JPG")=True  Then
P.Name 在此程式中->依序傳回每一資料夾中的File的名稱
兩者的解釋似乎有差異,傳回某字串指的是所指定之路徑名稱字串嗎?
另外如果要同時載入圖片時,順帶於另一欄位載入圖片檔名,程式碼該如何撰寫?謝謝!

GBKEE

回復 5# cmo140497
某字串 ->P.Name ,  一字串->".JPG"  
If InStr(UCase(某字串), "一字串") >0  Then   ->  比對到了  P 為 JPG格式的圖片檔

For Each P In E.Files
       If InStr(UCase(P.Name), ".JPG") Then
             With Sheets(i)
                    . Cells(ii, 1) = P.Name             'A欄輸入 圖片檔案名稱  
                   '.Cells(ii, 1) = P                        'A欄輸入  圖片檔案完整路徑名稱            
                  .Pictures.Insert(P).Top =.Cells(ii, 2).Top          'B欄 插入 圖片檔  
                  .Pictures.Insert(P).Left =.Cells(ii, 2).Left
                  .Pictures.Insert(P).Width = 50
                  .Pictures.Insert(P).Height = 50
             End With
             ii = ii + 5
      End If
Next

cmo140497

感謝版主不厭其煩地指正,太感謝您了!