Hsieh

回復 4# peter9527

大意應是如此

1. Sub nn()
   
2. fd = ThisWorkbook.Path & "\"  '存檔目錄
   
3. mymoon = Format(Date, "mm")  '月份
   
4. Set fs = CreateObject("Scripting.FileSystemObject")
   
5. Do
   
6. i = i + 1
   
7. fc = fs.fileexists(fd & mymoon & Format(i, "00") & ".xls")  '檢查檔名是否存在
   
8. Loop Until fc = False
   
9. mystr = mymoon & Format(i, "00")  '新檔名稱
   
10. yn = MsgBox("是否要另存為" & mystr & ".xls", vbYesNo)
    
11. If yn = 6 Then ThisWorkbook.SaveAs fd & mystr & ".xls" Else MsgBox "檔案未另存"
    
12. End Sub

複製代碼

Hsieh

回復 7# peter9527
2003版應該有filesearch可用，因應2007版以上使用DIR函數計算

1. Function Files_Count(Fd As String, Fs As String) As Integer 'Fd檔案目錄，Fs搜尋檔名
   
2. findfs = Dir(Fd & Fs)
   
3. Do Until findfs = ""
   
4.    Files_Count = Files_Count + 1
   
5.    findfs = Dir
   
6. Loop
   
7. End Function
   
8. Sub add_filename()
   
9. k = Files_Count(ThisWorkbook.Path & "\", Format(Date, "yymm") & "*.xls")
   
10. fc = Format(Date, "yymm") & "_" & k + 1 & ".xls"
    
11. yn = MsgBox("是否要另存為" & fc, vbYesNo)
    
12. If yn = 6 Then ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & fc Else MsgBox "檔案未另存"
    
13. End Sub

複製代碼

Hsieh

回復 9# peter9527


    程式設計最重要的就是規則
你要從命名規則中思考
了解如何套用?
不然別人也不懂你在描述什麼?
你就無法得到解答

Hsieh

回復 11# peter9527

那就要找到最大編號的檔名

1. Function topfile(fn$, fd$) As Integer
   
2. fs = Dir(fd & fn)
   
3. Do Until fs = ""
   
4. If Val(Replace(fs, Val(fn), "")) > topfile Then topfile = Val(Replace(fs, Val(fn), ""))
   
5. fs = Dir
   
6. Loop
   
7. End Function
   
8. Sub Save_File()
   
9. Dim f$
   
10. d = Format(Date, "yymm")
    
11. f = ThisWorkbook.Path & "\"
    
12. k = Format(topfile(d & "*.xls", f) + 1, "00")
    
13. fs = f & d & k & ".xls"
    
14. yn = MsgBox("是否另存為" & d & k & ".xls", vbYesNo)
    
15. If yn = 6 Then ThisWorkbook.SaveAs fs
    
16. End Sub

複製代碼