伊莉討論區

標題: VBA 收尋萬用字元問題 [打印本頁]

---

作者: box299    時間: 2018-7-11 12:51 PM     標題: VBA 收尋萬用字元問題



各位大神小弟一事請教!!

我有一個Excel VBA可以重指定資料夾抓取圖檔並匯入

但是該檔案只能抓取檔案全名(例如:1234.JPG)

不能以萬用字元抓取檔名(例如:*34.jpg)

可否請各位大神們賜教!!

-------------------------------------------------------------------------------------------------

1. Private Sub cmdMerge_Click()
   
2. Dim a, b, c As Integer '宣告a,b,c為整數
   
3. 
   
4. Dim objsheet As Worksheet
   
5. 
   
6. WorkName = Excel.ActiveWorkbook.Name '此檔案名稱
   
7. 
   
8. 
   
9. i = 6
   
10. 
    
11. Z = 1
    
12. 
    
13. picHeight = Range("b1")
    
14. picWidth = Range("b2")
    
15. picColumn = Range("b3")
    
16. picAngle = Range("b4")
    
17. 
    
18. '將之前產生的圖片清除
    
19. Sheet3.Activate
    
20. Sheet3.Shapes.SelectAll
    
21. Selection.Delete
    
22. 
    
23. 
    
24. While Sheet1.Range("b" & i) <> ""
    
25. 
    
26. FilePath = Sheet1.Range("a" & i)
    
27. Filename = Sheet1.Range("b" & i)
    
28. 
    
29. If FilePath = "" Then
    
30. Fullpath = Excel.Workbooks(WorkName).Path & "*" & Filename
    
31. Else
    
32. If Right(FilePath, 1) = "*" Then
    
33. Fullpath = FilePath & Filename
    
34. Else
    
35. Fullpath = FilePath & "*" & Filename
    
36. End If
    
37. End If
    
38. 
    
39. '檢查檔案是否存在
    
40. If Dir(Fullpath) <> "" Then
    
41. 
    
42. Sheet3.Activate
    
43. 
    
44. Sheet3.Range(picColumn & Z).Select
    
45. 
    
46. 
    
47. Set shpPic = Excel.ActiveSheet.Shapes.AddPicture(Fullpath, True, True, Selection.Left, Selection.Top, -1, -1)
    
48. 
    
49. If picHeight > 0 Then
    
50. shpPic.Height = 28.5 * picHeight
    
51. 
    
52. '調整列高度
    
53. Sheet3.Rows(Z).RowHeight = 28.5 * picHeight
    
54. 
    
55. End If
    
56. 
    
57. If picWidth > 0 Then
    
58. shpPic.Width = 28.5 * picWidth
    
59. End If
    
60. 
    
61. shpPic.Rotation = picAngle
    
62. 
    
63. Selection.Cut '2007才需要底下這樣作
    
64. 
    
65. Sheet3.Range(picColumn & Z).Select
    
66. 
    
67. ActiveSheet.Paste
    
68. Else
    
69. MsgBox "檔案:" & Fullpath & "不存在，請查看是否有拼錯字"
    
70. End If
    
71. i = i + 1 '讀取下一個名稱
    
72. Z = Z + 1
    
73. Wend
    
74. 
    
75. 
    
76. MsgBox "執行完成", vbOKOnly, ""
    
77. 
    
78. End Sub

複製代碼

---

作者: tryit244178    時間: 2018-7-11 04:50 PM



改用FileSystemObject
參考這篇
https://tw.answers.yahoo.com/question/index?qid=20090504000010KK10224

---

作者: Waroger    時間: 2018-7-12 06:08 PM

1. Private Sub CommandButton1_Click()
   
2.     p = Dir("D:\*34.jpg", vbNormal)
   
3.     Do While p <> ""
   
4.        If p <> "." And p <> ".." Then
   
5.           Debug.Print p
   
6.        End If
   
7.        p = Dir
   
8.     Loop
   
9. End Sub

複製代碼

---

歡迎光臨 伊莉討論區 (http://222.eyny.com/)

Powered by Discuz!