Board logo

標題: 關於VBA另存檔案名稱 [打印本頁]
作者: peter9527    時間: 2011-1-10 00:46     標題: 關於VBA另存檔案名稱

最近在EXCEL裡面另外做了一個另存新檔的按鈕
因為檔案名稱都是自動由"月份" & "01"命名的檔案名稱
去年11月開始做的
EX:1101   1102  1103
那時並無發現異常
現在1月才遇到狀況
那就是存檔發現前面少了0
EX:101   102   103
試了好多方法都無法讓他前面有0
也試過先將資料存在某儲存格
在用儲存格命名一樣沒有0
不知道有什麼方法可以辦到呢???
請各位大大幫忙我吧....
作者: solely    時間: 2011-1-10 12:51

回復 1# peter9527
如果資料來源B1是日期型態2011/01/10
Format(Range("B1"),"mm")
如果資料來源B1是數值型態20110110
Mid(Range("B1"),5,2)
如果還不行，就貼一下你的程式碼吧~~

我比較不喜歡思考，所以直接以"客戶名稱+建檔時間"為檔名XD
ActiveWorkbook.SaveAs Filename:="D:\成本試算表\" & Range("F2") & Format(Range("AH1"), "yyyymmddhhss") & ".xls"
作者: GBKEE    時間: 2011-1-10 21:22

回復 1# peter9527
ActiveWorkbook.SaveAs Filename:="D:\成本試算表\"  & Format(Date, "MMDD") & ".xls"
作者: peter9527    時間: 2011-1-11 00:37

回復 2# solely


    因為公司要的格式就是要這樣
假設是1月的第一筆資料就是0101  第二筆0102...以此類推
所以才會這麼麻煩.....

你的方法確實可行
可是我不知道要怎麼運用在我的程式裡面

程式碼如下
Private Sub CommandButton1_Click()


direct = ThisWorkbook.Path & "\"
session2 = Month(Date) & "01"

Do
Set fs = CreateObject("Scripting.FileSystemObject")
b = fs.fileExists(direct & session2 & ".xls")
session2 = session2 + 1
Loop Until b = False


Var = MsgBox("是否要另存檔案名稱 " & session2 - 1, vbOKCancel, "另存提示")
If Var = vbOK Then
Worksheets("Sheet1").Range("L1") = Date

direct = ThisWorkbook.Path & "\"
session1 = Month(Date) & "01"

Do
Set fs = CreateObject("Scripting.FileSystemObject")
a = fs.fileExists(direct & session1 & ".xls")
session1 = session1 + 1
Loop Until a = False
    Application.DisplayAlerts = False
    Sheets("Sheet3").Select
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True

ActiveWorkbook.SaveAs Filename:=direct & session2 - 1 & ".xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
MsgBox "檔案名稱 " & session2 - 1 & " 另存成功!!"
End If

If Var = vbCancel Then
End If
End Sub
作者: Hsieh    時間: 2011-1-11 12:24

回復 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
複製代碼
作者: peter9527    時間: 2011-1-11 22:19

回復 5# Hsieh

太感謝了
竟然只用短短的幾行就搞定了我的難題
真不知道該怎麼感謝你
最後再一次感謝大大的幫忙...真的是非常謝謝你...幫了我大忙
作者: peter9527    時間: 2011-2-11 21:37

回復  peter9527

大意應是如此
Hsieh 發表於 2011-1-11 12:24



    Hsieh大大
我又有一個問題了
如果說我想要把fc = fs.fileexists(fd & mymoon & Format(i, "00") & ".xls")  '檢查檔名是否存在
這一段改成判斷檔案名稱的前四個數字是否有存在
要怎麼改呢

因為有時候檔案名稱後面可能會加一些註記
這樣下一次另存檔案的抓之前檔名就跑掉了
要自己改檔名...
作者: Hsieh    時間: 2011-2-13 13:20

回復 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
複製代碼
作者: peter9527    時間: 2011-2-16 23:30

回復 8# Hsieh


    感謝大大的指導
可是我想把他運用在我原本的檔案名稱儲存格式
"當月月份" & "00" + 1
0201    0202   0203....以此類推
怎麼用都用不好
不知該如何修改
作者: Hsieh    時間: 2011-2-17 08:32

回復 9# peter9527


    程式設計最重要的就是規則
你要從命名規則中思考
了解如何套用?
不然別人也不懂你在描述什麼?
你就無法得到解答
作者: peter9527    時間: 2011-2-24 02:46

回復 10# Hsieh


    Hsieh大大 不好意思 前幾天比較忙 現在才有空
其實我那個問題主要是又碰到命名方式 "月份"&"數字"
數字的格式部份...10以下的數字前面沒有"0"...不過我已經修改好了

最後我有測試
大致上都可正常運作
不過我後來發現有一個小問題
如果把之前儲存的其中一個檔案刪除掉
之後的儲存檔案就會出現問題了
會跟最後一次儲存的檔案名稱重複儲存
我以為是我有不小心改錯程式碼
用Hsieh大大的原始碼去測試
也是有一樣的情況發生...
作者: Hsieh    時間: 2011-2-24 11:30

回復 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
複製代碼




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