Board logo

標題: [發問] 如何用VBA批次開啟JPG檔並存檔？ [打印本頁]
作者: smart3135    時間: 2018-4-11 08:36     標題: 如何用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
全都開啟並存檔一次
作者: smart3135    時間: 2018-4-12 16:22

回復 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

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

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

  26. Private Type FileTime
  27.     dwLowDateTime As Long
  28.     dwHighDateTime As Long
  29. End Type

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

  38. '設定檔案時間
  39. Private Function SetTime(f As String, t1 As FileTime, t2 As FileTime, t3 As FileTime)
  40.     lngHandle = CreateFile(f, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
  41.     SetFileTime lngHandle, t1, t1, t2
  42.     CloseHandle lngHandle
  43. End Function

  45. Private Sub Command1_Click()

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




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