Board logo

標題: [發問] 更新日期+假日不更新 [打印本頁]
作者: cowww    時間: 2023-4-13 11:30     標題: 更新日期+假日不更新

最近寫了一段自動更新的語法
但是有遇到兩個問題
1.
外單位的Excel檔名會依照日期去修改，要如何寫VBA讓抓取的指定路徑名稱跟日期一樣
Workbooks.Open ("\\SMK\B.各組資料 (Team inform)\E.生管組 (PPC group)\D.生產相關\2.每日模具異動\模具異動-六福\2023.04.13 每日模具異動.xlsx")
Workbooks.Open ("\\SMK\B.各組資料 (Team inform)\E.生管組 (PPC group)\X.自動化工具(勿刪)\模具異動-六福(急件1.9專用)\LF每日模具異動.xlsx")
Workbooks("LF每日模具異動.xlsx").Worksheets("LF").Range("A:AG").ClearContents
Workbooks("2023.04.13 每日模具異動.xlsx").Worksheets("LF").Columns("A:AG").Cells.Copy
Workbooks("LF每日模具異動.xlsx").Worksheets("LF").Range("A:AG").PasteSpecial Paste:=xlPasteValues
[attach]36125[/attach]

2.
六日無人上班所以不會更新，要如何寫VBA讓系統遇到假日不執行更新
Private Sub Workbook_Open()
    Application.OnTime TimeValue("06:00:00"), "full_calc"
End Sub
作者: Andy2483    時間: 2023-4-13 12:29

回復 1# cowww


    謝謝論壇,謝謝各位前輩,謝謝前輩發表此主題
後學學習的建議如下:

Sub Format_Date() '每週的第一天是星期日
MsgBox "-六福\" & Format(Date, "yyyy.mm.dd") & " 每日模具異動.xlsx"
MsgBox Format("2023/4/13", "W")
End Sub
'其他非六.日國定假日.補假.補班須要對照表,請參考
http://forum.twbts.com/thread-23838-1-1.html
作者: cowww    時間: 2023-4-13 13:16

回復 2# Andy2483

非常感謝Andy2483大大的解答
第一個問題解決了

第二個解決辦法，小弟真的看不懂
可以請Andy2483大大說明嗎??
其實我的需求很簡單，遇到六日時就讓VBA去抓星期五的日期就好
補班or連假的問題可以先避開沒關係
作者: Andy2483    時間: 2023-4-13 13:47

回復 3# cowww

謝謝前輩再回復
"遇到六日時就讓VBA去抓星期五的日期就好"
後學對此情境的解決方案如下,請前輩參考

Sub 六日抓五() '每週的第一天是星期日
Dim A%, B$
A = Format(Date, "W")
B = Format(Switch(A = 7, Date - 1, A = 1, Date - 2, A > 1, Date), "yyyy.mm.dd")
MsgBox B
End Sub
作者: cowww    時間: 2023-4-13 17:23

回復 4# Andy2483

因為自動執行的時間是指定在早上06:00開始，也就是說抓的外單位檔案名稱的日期會是昨天的(過了00:00)
Private Sub Workbook_Open()
    Application.OnTime TimeValue("06:00:00"), "full_calc"
End Sub

請問Andy2483大大，可不可以把Workbooks.Open......"B"改成"B-1"就可以在早上06:00自動執行時抓到昨天日期的外單位資料??
A = Format(Date, "W")
B = Format(Switch(A = 7, Date - 1, A = 1, Date - 2, A > 1, Date), "yyyy.mm.dd")
Workbooks.Open ("\\SMK\B.各組資料 (Team inform)\E.生管組 (PPC group)\D.生產相關\2.每日模具異動\模具異動-六福\" & B - 1 & " 每日模具異動.xlsx")
作者: Andy2483    時間: 2023-4-13 19:51

回復 5# cowww


    B = Format(Switch(A = 7, Date - 1, A = 1, Date - 2, A > 1, Date) -1, "yyyy.mm.dd")
作者: cowww    時間: 2023-4-14 08:13

回復 6# Andy2483

非常感謝Andy2483大大的指導

請問紅色字體那段哪裡寫錯了??
2023.04.14 每日模具異動->是因為日期和文字之間有一個空格造成的嗎??
'開啟六幅異動表
A = Format(Date, "W")
B = Format(Switch(A = 7, Date - 1, A = 1, Date - 2, A = 2, Date - 3, A > 2, Date - 1), "yyyy.mm.dd")
MsgBox B
Workbooks.Open ("\\SMK\B.各組資料 (Team inform)\E.生管組 (PPC group)\D.生產相關\2.每日模具異動\模具異動-六福\" & B & " 每日模具異動.xlsx")
[attach]36129[/attach]

MsgBox B->顯示的日期沒有問題
[attach]36130[/attach]
作者: Andy2483    時間: 2023-4-14 08:28

本帖最後由 Andy2483 於 2023-4-14 08:32 編輯

回復 7# cowww

出現什麼錯誤訊息嗎?
作者: cowww    時間: 2023-4-14 08:51

回復 8# Andy2483


非常抱歉
剛剛檢查了所有會使用到的excel發現
六幅異動表的日期在凌晨03:21就更新日期
以前都是早上08:00之後才更改，所以自動執行的時間我才會設定06:00
[attach]36131[/attach]

剛剛把語法改成A>1,date就沒問題了

非常感謝Andy2483大大的指導
作者: cowww    時間: 2023-4-14 13:09

回復 7# cowww

請問這段判斷式哪裡寫錯了
我希望系統先去找當天日期的異動表，可是它都是去找昨天的日期
如果"有"->執行If
如果"沒有"->再Else
A = Format(Date, "W")
If B = Format(Date, "yyyy.mm.dd") Then
Workbooks.Open ("\\shl-group.com\dept\MFMG\B.各組資料 (Team inform)\E.生管組 (PPC group)\D.生產相關\2.每日模具異動\模具異動-六福\" & B & " 每日模具異動.xlsx")

Else: B = Format(Switch(A = 7, Date - 1, A = 1, Date - 2, A = 2, Date - 3, A > 2, Date - 1), "yyyy.mm.dd")
Workbooks.Open ("\\shl-group.com\dept\MFMG\B.各組資料 (Team inform)\E.生管組 (PPC group)\D.生產相關\2.每日模具異動\模具異動-六福\" & B & " 每日模具異動.xlsx")
作者: Andy2483    時間: 2023-4-14 14:46

回復 10# cowww


    If B = Format(Date, "yyyy.mm.dd") Then
前方沒有給B變數值,所以
B 必定不等於 Format(Date, "yyyy.mm.dd")
作者: Andy2483    時間: 2023-4-14 14:57

回復 10# cowww


Sub 判定路徑下檔案是不是存在()
If Dir("D:\2023.04.14 TEST.xls") <> Empty Then
   MsgBox "有這檔案"
End If
End Sub
作者: Andy2483    時間: 2023-4-14 15:17

回復 10# cowww


Sub 先判定是不是有今天的()
Dim T$, A%, B$
T = "\\shl-group.com\dept\MFMG\B.各組資料 (Team inform)\E.生管組 (PPC group)\D.生產相關\2.每日模具異動\模具異動-六福\"
A = Format(Date, "W")
B = Format(Date, "yyyy.mm.dd")
If Dir(T & B & " 每日模具異動.xlsx") = Empty Then
   B = Format(Switch(A = 7, Date - 1, A = 1, Date - 2, A = 2, Date - 3, A > 2, Date - 1), "yyyy.mm.dd")
   If Dir(T & B & " 每日模具異動.xlsx") = Empty Then MsgBox "找不到 " & B & " 檔案": Exit Sub
End If
Workbooks.Open (T & B & " 每日模具異動.xlsx")
End Sub
作者: Andy2483    時間: 2023-4-14 21:20

回復 10# cowww


    用13#樓查檔案是否存在的方式再多一個回圈 從今天開始判定，找不到就倒退日期繼續找，找到就跳出迴圈，開啟檔案
如此方式可以找到最新的，不必考慮星期幾？
作者: cowww    時間: 2023-4-15 20:13

回復 14# Andy2483

非常感謝Andy2483大大的解答
看看明天是否會成功

明明有寫關閉提示的語法，為何開啟其他單位的異動表還是要輸入密碼呢??
'關閉提示
Application.DisplayAlerts = False
T = "\\shl-group.com\dept\MFMG\B.各組資料 (Team inform)\E.生管組 (PPC group)\D.生產相關\2.每日模具異動\模具異動-六福\"
A = Format(Date, "W")
B = Format(Date, "yyyy.mm.dd")
If Dir(T & B & " 每日模具異動.xlsx") = Empty Then
   B = Format(Switch(A = 7, Date - 1, A = 1, Date - 2, A = 2, Date - 3, A > 2, Date - 1), "yyyy.mm.dd")
   If Dir(T & B & " 每日模具異動.xlsx") = Empty Then MsgBox "找不到 " & B & " 檔案": Exit Sub
End If
Workbooks.Open (T & B & " 每日模具異動.xlsx")
[attach]36141[/attach]
作者: Andy2483    時間: 2023-4-15 21:46

回復 15# cowww


    Set xB = Workbooks.Open(ThisWorkbook.Path & "\" & BKN & ".xls", ReadOnly:=True) '唯讀開啟檔案
http://forum.twbts.com/viewthrea ... 2Bonly%3A%3D%2BTrue
作者: cowww    時間: 2023-4-16 11:08

回復 14# Andy2483


抱歉
Andy2483大大
我是新手(為了工作被迫學函數和VBA)，不會寫迴圈
作者: Andy2483    時間: 2023-4-16 12:47

回復 17# cowww


For i = 0 To 10
   B = Format(Date -i, "yyyy.mm.dd")
   Msgbox B
Next
作者: cowww    時間: 2023-4-17 13:05

回復 18# Andy2483


非常感謝Andy2483大大的解答
但是我還是不知道那段語法要放哪個位置
我另外做一個按鈕來測試是否能夠開啟
Sub 按鈕2_Click()
T = "\\shl-group.com\dept\MFMG\B.各組資料 (Team inform)\E.生管組 (PPC group)\X.自動化工具(勿刪)\模具異動-六福(急件1.9專用)\"

A = Format(Date, "W")
B = Format(Date, "yyyy.mm.dd")
If Dir(T & B & " 每日模具異動.xlsx") = Empty Then
   For i = 0 To 10
   B = Format(Date - i, "yyyy.mm.dd")
   If Dir(T & B & " 每日模具異動.xlsx") = Empty Then MsgBox "找不到 " & B & " 檔案": Exit Sub
   Next
End If
Workbooks.Open filename:=T & B & " 每日模具異動.xlsx", ReadOnly:=True
End Sub
[attach]36147[/attach]
作者: Andy2483    時間: 2023-4-17 13:46

回復 19# cowww


    謝謝前輩再回復,一起學習
以下是學習方案,請前輩參考

Option Explicit
Sub TEST()
Dim T$, B$, i%
T = "\\shl-group.com\dept\MFMG\B.各組資料 (Team inform)\E.生管組 (PPC group)\X.自動化工具(勿刪)\模具異動-六福(急件1.9專用)\"
For i = 0 To 10
   B = Format(Date - i, "yyyy.mm.dd")
   If Dir(T & B & " 每日模具異動.xlsx") <> Empty Then GoTo i01
Next
MsgBox "找不到 " & Date & " ~ " & Date - 10 & " 檔案": Exit Sub
i01: Workbooks.Open Filename:=T & B & " 每日模具異動.xlsx", ReadOnly:=True
End Sub
作者: cowww    時間: 2023-4-17 15:13

回復 20# Andy2483

成功了
非常感謝Andy2483大大解答

有個地方我看不懂
If Dir(T & B & " 每日模具異動.xlsx") <> Empty Then GoTo i01

<>為何是用不等於的符號
作者: Andy2483    時間: 2023-4-17 15:25

回復 21# cowww


    Empty(空的)
<>Empty(不是空的)就是有
作者: cowww    時間: 2023-4-17 15:56

回復 22# Andy2483

我懂了
非常感謝Andy2483大大的解答
作者: Andy2483    時間: 2023-4-18 08:38

回復 23# cowww


    謝謝前輩回復,一起學習,謝謝論壇,謝謝各位前輩
後學藉此帖複習方案,方案的心得註解如下,請前輩參考,請各位前輩指教

Option Explicit
Sub TEST()
Dim T$, B$, i%
'↑宣告變數(T,B)是字串變數,i是短整數
T = "\\shl-group.com\dept\MFMG\B.各組資料 (Team inform)\E.生管組 (PPC group)\X.自動化工具(勿刪)\模具異動-六福(急件1.9專用)\"
'↑令T這字串變數是 "資料夾位址\"
For i = 0 To 10
'↑設順迴圈!i從0 到10
   B = Format(Date - i, "yyyy.mm.dd")
   '↑令B這字串變數是 今天日期減掉i變數後的日期轉換成字串,
   '字串:4碼年2碼月2碼日中間加"."符號
   If Dir(T & B & " 每日模具異動.xlsx") <> Empty Then GoTo i01
   '↑以T變數連接 B變數,再連接 " 每日模具異動.xlsx"的新字串,
   '如果這新字串去查有這個檔案?? (PS:不是空的就是有的意思)
   '如果有這檔案就跳到 i01標示位置繼續執行
Next
MsgBox "找不到 " & Date & " ~ " & Date - 10 & " 檔案": Exit Sub
'↑當上述迴圈跑完了還找不到想要的位址與檔名檔案!
'就跳出提示窗,顯示11天區間日期沒有符合的檔案
'最後結束程式執行
i01: Workbooks.Open Filename:=T & B & " 每日模具異動.xlsx", ReadOnly:=True
'↑唯讀開啟檔案
End Sub
作者: cowww    時間: 2023-4-18 14:22

回復 24# Andy2483


非常感謝Andy2483大大精闢解說
小弟受益良多



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