返回列表 上一主題 發帖

[發問] 如何用VBA批次開啟JPG檔並存檔?

[發問] 如何用VBA批次開啟JPG檔並存檔?

請教各位前輩高手,因工作上需要,我想要寫一個VBA程式
可以開啟某個資料夾下的所有JPG圖檔(不知道能不能用*.jpg),並由程式碼判定找無檔案就停止(應該是要寫迴圈)
然後將每個開啟的檔案存檔並關閉,不需變更檔名
存檔的目的只是為了將檔案的修改日期變成今日
不知道程式碼應該怎麼寫,懇請各位指導一下,感恩。
例:C槽的pic資料夾中有1,2,3,4,5 JPG檔
我想將C:\pic\1.jpg、C:\pic\2.jpg、C:\pic\3.jpg、C:\pic\4.jpg、C:\pic\5.jpg
全都開啟並存檔一次

回復 1# smart3135
後來爬文有找到這個,可以批次變更檔案最後修改時間
不過會連建立時間與存取時間一起變更
不知道能不能單純只變更檔案最後修改時間,另外兩個時間不去動到
  1. '檔案時間讀取、設定的 API 及常數宣告
  2. Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
  3. Private Declare Function GetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FileTime, lpLastAccessTime As FileTime, lpLastWriteTime As FileTime) As Long
  4. Private Declare Function SetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FileTime, lpLastAccessTime As FileTime, lpLastWriteTime As FileTime) As Long
  5. Private Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FileTime) As Long
  6. Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FileTime, lpSystemTime As SYSTEMTIME) As Long
  7. Private Declare Function LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As FileTime, lpFileTime As FileTime) As Long
  8. Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

  9. Private Const GENERIC_WRITE = &H40000000
  10. Private Const OPEN_EXISTING = 3
  11. Private Const FILE_SHARE_READ = &H1
  12. Private Const FILE_SHARE_WRITE = &H2

  13. Private Type SYSTEMTIME
  14.     wYear As Integer
  15.     wMonth As Integer
  16.     wDayOfWeek As Integer
  17.     wDay As Integer
  18.     wHour As Integer
  19.     wMinute As Integer
  20.     wSecond As Integer
  21.     wMilliseconds As Integer
  22. End Type

  23. Private Type FileTime
  24.     dwLowDateTime As Long
  25.     dwHighDateTime As Long
  26. End Type

  27. '取得檔案時間
  28. Private Function GetTime(f As String, t1 As FileTime, t2 As FileTime, t3 As FileTime)
  29.     lngHandle = CreateFile(f, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
  30.     GetFileTime lngHandle, t1, t1, t2
  31.     CloseHandle lngHandle
  32. End Function

  33. '設定檔案時間
  34. Private Function SetTime(f As String, t1 As FileTime, t2 As FileTime, t3 As FileTime)
  35.     lngHandle = CreateFile(f, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
  36.     SetFileTime lngHandle, t1, t1, t2
  37.     CloseHandle lngHandle
  38. End Function

  39. Private Sub Command1_Click()

  40.     Dim 檔名 As String
  41.     Dim 新日期時間 As Date
  42.     Dim 檔案建立時間 As FileTime
  43.     Dim 最後讀取時間 As FileTime
  44.     Dim 最後修改時間 As FileTime
  45.     Dim tmp As SYSTEMTIME
  46.    
  47.     新日期時間 = Now                    '<-----------預設檔案時間為當下
  48.     路徑 = "d:\tmp\"                    '<-----------檔案所在的資料夾
  49.     檔案類型 = "*.*"                  '<-----------選取的檔案類型
  50.    
  51.     tmp.wYear = Year(新日期時間)
  52.     tmp.wMonth = Month(新日期時間)
  53.     tmp.wDay = Day(新日期時間)
  54.     tmp.wHour = Hour(新日期時間)
  55.     tmp.wMinute = Minute(新日期時間)
  56.     tmp.wSecond = Second(新日期時間)
  57.     tmp.wMilliseconds = 0
  58.    
  59.     SystemTimeToFileTime tmp, 檔案建立時間
  60.     LocalFileTimeToFileTime 檔案建立時間, 檔案建立時間
  61.    
  62.     最後讀取時間 = 檔案建立時間         '<-----------把三個時間都設成一致
  63.     最後修改時間 = 檔案建立時間
  64.    
  65.     SetTime 檔名, 檔案建立時間, 最後讀取時間, 最後修改時間
  66.    
  67.     '進行更改
  68.     檔名 = Dir(路徑 & 檔案類型, vbNormal Or vbArchive Or vbReadOnly)
  69.     Do While 檔名 <> ""
  70.         SetTime 路徑 & 檔名, 檔案建立時間, 最後讀取時間, 最後修改時間
  71.         檔名 = Dir
  72.     Loop
  73.    
  74. End Sub
複製代碼

TOP

        靜思自在 : 待人退一步,愛人寬一寸,就會活得很快樂。
返回列表 上一主題