iT邦幫忙

0

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

想請問一下
有個資料夾內有數個檔案
品項 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

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

2 個回答

0
paicheng0111
iT邦高手 1 級 ‧ 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

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

0
海綿寶寶
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

感謝大大
如果要直接偵測開啟檔案其資料夾內的排序
要怎麼修改呢~

我要發表回答

立即登入回答