請問如何自動抓取資料夾內檔案編號?

excel excel vba

haha963741 2018-05-29 00:55:16 ‧ 4162 瀏覽

想請問一下
有個資料夾內有數個檔案
品項 001 ??????
品項 002 ??????
品項 003 ??????
品項 004 ??????

有辦法使用VBA設置一個按鈕
按下去自動搜尋資料夾內最後一個編碼(EX:004)
然後將該編碼往後遞增一個(005)填入指定儲存格中嗎?
PS:前面"品項"為固定字元中間編號依序跳動最後檔名字元皆不同

感謝各位~

只有找到在另存新檔時自動編碼的
但是怎麼改都無法寫入儲存格
下面是找到的代碼
Function topfile(fn$, fd$) As Integer
fs = Dir(fd & fn)
Do Until fs = ""
If Val(Replace(fs, Val(fn), "")) > topfile Then topfile = Val(Replace(fs, Val(fn), ""))
fs = Dir
Loop
End Function
Sub Save_File()
Dim f$
d = Format(Date, "yymm")
f = ThisWorkbook.Path & ""
k = Format(topfile(d & "*.xls", f) + 1, "00")
fs = f & d & k & ".xls"
yn = MsgBox("是否另存為" & d & k & ".xls", vbYesNo)
If yn = 6 Then ThisWorkbook.SaveAs fs
End Sub

paicheng0111 iT邦大師 5 級 ‧ 2018-05-29 09:18:23 檢舉

可以用`逐步執行`來除錯。

登入發表討論

直播研討會

{{ item.channelVendor }} {{ item.webinarstarted }} |

直播中

2 個回答

paicheng0111

iT邦大師 5 級 ‧ 2018-05-29 09:10:27

function findLast(sDir as string) as string
    dim f as string, serial as variant
    
    f = dir(sDir & "\" & "品項*.xls")
    findLast = f
    Do Until f = ""
        if f > findLast then findLast = f
        f = dir
    Loop
end function


sub writeCell()
    dim f as string, sDir as string, address as string, newN as string
    
    address = "A1"
    sDir = "C:\AAA\bbb"
    f = findLast(sDir)
    if f = "" then Range(address).Value = "'000"
    newN = right(left(f,5),3)
    newN = format(val(newN) + 1, "000")
    Range(address).Value = "'" & newN
End Sub

回應 1
分享
檢舉

haha963741 iT邦新手 5 級 ‧ 2018-05-29 19:19:00 檢舉

顯示該巨集無法在活頁簿中使用
已開啟權限也一樣QQ

登入發表回應

海綿寶寶

iT邦大神 1 級 ‧ 2018-05-29 15:51:30

Sub GetNewCount()
    NewCount = 0
    fs = Dir("D:\test\品項*")
    Do Until fs = ""
        If Val(Mid(fs, 3, 3)) > NewCount Then
            NewCount = Val(Mid(fs, 3, 3))
        End If
        fs = Dir
    Loop
    Range("A1").Value = Format(NewCount + 1, "'000")
End Sub