標題:
[發問]
判斷資料夾內是否有檔案
[打印本頁]
作者:
a703130
時間:
2012-12-5 10:30
標題:
判斷資料夾內是否有檔案
本帖最後由 a703130 於 2012-12-5 10:32 編輯
下面是我的一部份程式碼,目標是從a.xls抓檔案名稱,再去資料夾內抓取圖檔,修改大小後放回a.xls檔
目前遇到一個問題,就是當我a.xls抓了檔案名稱,但是資料夾內沒有檔案,我該如何判斷
是否在第15行前加入一判斷式,判斷檔案名稱是否存在於資料夾,如果沒有則離開if 判斷式
判斷檔案是否存在,這部分我不知道如何寫~是否能請前輩幫忙,感激不盡
Sub InsertImage(ImagePath, FolderName)
Dim ReadRow As Integer
Dim ImageName As String
Sheets("a").Select
ReadRow = 24
'判斷Safety頁面第一欄是否有需要載入圖檔直至出現"END"字樣
Do Until UCase(Cells(ReadRow, 1)) = "END"
ImageName = Cells(ReadRow, 1)
'利用CheckFileName func 來判斷是否有關鍵字 ".PNG & .JPG",如果有則載入圖片
If CheckFileName(UCase(ImageName)) = True Then
Cells(ReadRow, 2).Select
ActiveSheet.Pictures.Insert(ImagePath & "\" & FolderName & "\" & ImageName).Select
Call ImageSize
Else
End If
ReadRow = ReadRow + 1
Loop
End Sub
Function CheckFileName(ByVal ImageName As Variant) As Boolean
Dim ImageLenth As Integer
Select Case ImageName
'如果空白則離開此 func
Case Is = ""
CheckFileName = False
Exit Function
'計算字串長度並擷取後面4個字元,判斷是否有關鍵字 ".PNG & .JPG",如果有則載入圖片
Case Else
ImageLenth = Len(ImageName)
ImageName = Mid(ImageName, ImageLenth - 4 + 1, 4)
If ImageName = ".PNG" Or ImageName = ".JPG" Then
CheckFileName = True
Else
CheckFileName = False
End If
End Select
End Function
'設定圖檔的Size大小及位置
Sub ImageSize()
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 289.5
Selection.ShapeRange.Width = 531.75
Selection.ShapeRange.Rotation = 0#
Selection.ShapeRange.IncrementLeft 5#
Selection.ShapeRange.IncrementTop 5#
End Sub
複製代碼
作者:
a703130
時間:
2012-12-5 10:33
已經不能編輯帖子~應該是14行上面,插圖片之前
作者:
GBKEE
時間:
2012-12-5 10:48
本帖最後由 GBKEE 於 2012-12-5 11:17 編輯
回復
1#
a703130
Option Explicit
Sub Ex() '判斷資料夾內是否有檔案
'Dir("D:\test\*.PNG") = "" 為資料夾中檔案沒有副檔名是PNG的檔案
'判斷資料夾中檔案是否有關鍵字 ".PNG & .JPG"
If Dir("D:\test\*.PNG") = "" And Dir("D:\test\*.JPG") = "" Then MsgBox "資料夾中沒有 .PNG .JPG"
End Sub
複製代碼
整理一下你的程式碼
Option Explicit
Sub InsertImage(ImagePath, FolderName)
Dim ReadRow As Integer, ImageName As String
Sheets("a").Select
ReadRow = 24
'判斷Safety頁面第一欄是否有需要載入圖檔直至出現"END"字樣
Do Until UCase(Cells(ReadRow, 1)) = "END"
'ImageName = Cells(ReadRow, 1)
ImageName = ImagePath & "\" & FolderName & "\" & Cells(ReadRow, 1)
If InStr(ImageName, ".PNG") Or InStr(ImageName, ".JPG") Then
If Dir(ImageName) <> "" Then
Cells(ReadRow, 2).Select
ActiveSheet.Pictures.Insert(ImageName).Select
Call ImageSize
End If
End If
ReadRow = ReadRow + 1
Loop
End Sub
複製代碼
作者:
a703130
時間:
2012-12-5 15:19
謝謝前輩,還勞煩您幫我整理程式碼,因為還不熟悉所以到處都是註解
關於DIR 有進一步認識了
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)