各位先進
我的資料匣內有著如下,以不同時間存取為名的兩個類型的excel檔案
20210812_1300_data1.xls
20210812_1300_data2.xls
20210812_1330_data1.xls
20210812_1330_data2.xls
20210812_1400_data1.xls
20210812_1400_data2.xls
20210812_1430_data1.xls
20210812_1430_data2.xls
想請教一下,如何使用VB寫出僅抓取(保留)最新的檔案並自動刪除較舊的檔案?
08/13
很抱歉..新手訓練期間無法回應
japhenchen
我不會使用Powershell,但還是非常感謝您的幫忙
海綿寶寶
我試過了..沒問題..非常感謝您
1.複製貼上程式碼(在最底下)
2.修改 xls 檔所在路徑
(sPath = "D:\kill")
3.先確定執行結果正確(如下範例)
D:\kill\20210812_1300_data1.xls was deleted
D:\kill\20210812_1300_data2.xls was deleted
D:\kill\20210812_1330_data1.xls was deleted
D:\kill\20210812_1330_data2.xls was deleted
D:\kill\20210812_1400_data1.xls was deleted
D:\kill\20210812_1400_data2.xls was deleted
D:\kill\20210812_1430_data1.xls was saved
D:\kill\20210812_1430_data2.xls was saved
4.再修改程式裡一列(會真的刪除)'Kill dirPath & thisFile.Name
改成Kill dirPath & thisFile.Name
改寫網路上抄來的程式碼如下
Option Explicit
Sub Main()
Dim fileToBeSaved(1 To 2) As String
Dim sPath As String
Dim arr() As String
sPath = "D:\kill\"
arr = SortedFiles(sPath, "_data1.xls")
fileToBeSaved(1) = arr(UBound(arr))
arr = SortedFiles(sPath, "_data2.xls")
fileToBeSaved(2) = arr(UBound(arr))
Call deleteDataFiles(sPath, ".xls", fileToBeSaved)
End Sub
Sub deleteDataFiles(ByVal dirPath As String, ByVal fileType As String, ByVal arrSaved)
Dim bSaved As Boolean
Dim saveFile As Variant
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim listFolder As Object
Set listFolder = fso.GetFolder(dirPath)
Dim thisFile As Object
For Each thisFile In listFolder.Files
If Right(thisFile.Name, Len(fileType)) = fileType Then
bSaved = False
For Each saveFile In arrSaved
If saveFile = thisFile.Name Then
bSaved = True
End If
Next
If (bSaved = False) Then
Debug.Print dirPath & thisFile.Name, " was deleted"
'Kill dirPath & thisFile.Name
Else
Debug.Print dirPath & thisFile.Name, " was saved"
End If
End If
Next thisFile
End Sub
Public Function SortedFiles(ByVal dirPath As String, ByVal fileType As String) As String()
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim listFolder As Object
Set listFolder = fso.GetFolder(dirPath)
' Make the list of names.
Dim fileCount As Long
fileCount = listFolder.Files.Count
Dim fileNames() As String
ReDim fileNames(1 To fileCount)
Dim i As Long
i = 1
Dim thisFile As Object
For Each thisFile In listFolder.Files
If Right(thisFile.Name, Len(fileType)) = fileType Then
fileNames(i) = thisFile.Name
i = i + 1
End If
Next thisFile
' Return the sorted list.
SortedFiles = QuickSort(fileNames, 1, fileCount)
End Function
' Use Quicksort to sort a list of strings.
'
' This code is from the book "Ready-to-Run
' Visual Basic Algorithms" by Rod Stephens.
' http://www.vb-helper.com/vba.htm
Public Function QuickSort(ByVal list As Variant, ByVal min As Long, ByVal max As Long) As String()
Dim midValue As String
Dim high As Long
Dim low As Long
Dim i As Long
Dim newList() As String
newList = list
' If there is 0 or 1 item in the list,
' this sublist is sorted.
If Not min >= max Then
' Pick a dividing value.
i = Int((max - min + 1) * Rnd + min)
midValue = newList(i)
' Swap the dividing value to the front.
newList(i) = newList(min)
low = min
high = max
Do
' Look down from hi for a value < mid_value.
Do While newList(high) >= midValue
high = high - 1
If high <= low Then Exit Do
Loop
If high <= low Then
newList(low) = midValue
Exit Do
End If
' Swap the lo and hi values.
newList(low) = newList(high)
' Look up from lo for a value >= mid_value.
low = low + 1
Do While newList(low) < midValue
low = low + 1
If low >= high Then Exit Do
Loop
If low >= high Then
low = high
newList(high) = midValue
Exit Do
End If
' Swap the lo and hi values.
newList(high) = newList(low)
Loop
' Sort the two sublists.
newList = QuickSort(newList, min, low - 1)
newList = QuickSort(newList, low + 1, max)
End If
QuickSort = newList
End Function
VBA找檔案的方法我不會,但Powershell我會
我剛學到一招除了最新的檔案,其他都殺掉的方法
把以下內容以文字編輯器,存成一個副檔名為 ps1 (不是PS5哦,是ps"one")的"超級批次檔",在上面按右鍵→以Powershell執行即可
路徑名是我的電腦下載資料夾,你自己再視情況修改
<# 下面那行的意思是 抓.../downloads/裡所有的 xls* 檔 | 按日期從舊到新排序 | 取得檔案物件 #>
<# | ← 這是管線,不懂的話要從頭開始學起,簡單說,就是把管線左邊的結果,直接傳給管線右邊的指令 #>
$files = @(Get-ChildItem -Path "C:\Users\JaphenChen\Downloads" -filter "*.xls*" -File -Force -ErrorAction SilentlyContinue | sort-object LastWriteTimeUtc| Select-Object FullName | Foreach-Object { $_.FullName })
<# 下面那行[0..-2]指的就是從最舊一路排到倒數第二新的檔案,最新的那個檔案不跑 #>
foreach ($f in $files[0..-2]) {
<# 把檔案物件的完全檔名抓出來 #>
$fp = [System.IO.Path]::GetFullPath($f)
<# 再確認..如果檔案確實存在的話 #>
if ([System.IO.File]::Exists($fp)) {
<# 刪除 ! #>
Remove-Item $fp
}
}