關於VBA另存檔案名稱

peter9527

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

solely

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

回復 1# peter9527
ActiveWorkbook.SaveAs Filename:="D:\成本試算表\"  & Format(Date, "MMDD") & ".xls"

peter9527

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

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

回復 5# Hsieh

太感謝了
竟然只用短短的幾行就搞定了我的難題
真不知道該怎麼感謝你
最後再一次感謝大大的幫忙...真的是非常謝謝你...幫了我大忙

peter9527

回復  peter9527

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

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

因為有時候檔案名稱後面可能會加一些註記
這樣下一次另存檔案的抓之前檔名就跑掉了
要自己改檔名...

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

複製代碼

peter9527

回復 8# Hsieh


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

Hsieh

回復 9# peter9527


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