PDA

View Full Version : [SOLVED:] How to close all .csv or .xlsx type file



xyz987
04-05-2024, 10:39 PM
Hi sirs
i want to close all csv and xlsx type file, when i restart program. i use * to filter, but it looks some problem... please give me some suggest, thanks.



Sub check_menu()
Dim wb As Workbook
'ThisWorkbook.Path:傳回本工作簿、檔案所儲存的路徑。
'ThisWorkbook.FullName:傳回本工作簿、檔案所儲存的路徑 + 檔名。
'ThisWorkbook.Name:傳回本工作簿、檔案所儲存的檔名。
'ActiveWindow.ActiveSheet.Name 或 ActiveSheet.Name 目前工作表名稱
work_book = ThisWorkbook.Name
'檔案檢查
If Dir("C:\stock", vbDirectory) = "" Then MkDir "C:\stock"
If Dir("C:\stock\analysis", vbDirectory) = "" Then MkDir "C:\stock\analysis"
If Dir("C:\stock\data", vbDirectory) = "" Then MkDir "C:\stock\data"
For file_check = 1 To Workbooks.Count
If Workbooks(file_check).Name = "*.csv" Then
Windows("*.csv").Activate
Application.DisplayAlerts = False
Windows("*.csv").Close (vb = yes)
Application.DisplayAlerts = True
End If
Next file_check
For file_check = 1 To Workbooks.Count
If Workbooks(file_check).Name = "*.xlsx" Then
Windows("*.xlsx").Activate
Application.DisplayAlerts = False
Windows("*.xlsx").Close (vb = no)
Application.DisplayAlerts = True
End If
Next file_check
'舊檔案刪除
If Len(Dir("C:\stock\*.*")) > 0 Then Kill "C:\stock\*.*"
'SetAttr "C:\stock\*.*", vbNormal ' 排除唯讀檔問
If Len(Dir("C:\stock\data\*.*")) > 0 Then Kill "C:\stock\data\*.*"
'SetAttr "C:\stock\data\*.*", vbNormal ' 排除唯讀檔問題
If Len(Dir("C:\stock\analysis\*.*")) > 0 Then Kill "C:\stock\analysis\*.*"
SetAttr "C:\stock\analysis\*.*", vbNormal ' 排除唯讀檔問題
End Sub

June7
04-05-2024, 11:27 PM
See if this helps https://answers.microsoft.com/en-us/msoffice/forum/all/vba-to-close-an-open-program/b0cd06e9-e12b-41b8-a92a-9cb0dbcef0be

xyz987
04-06-2024, 12:02 AM
solve it, thanks


Sub check_menu()
Dim wb As Workbook
'ThisWorkbook.Path:傳回本工作簿、檔案所儲存的路徑。
'ThisWorkbook.FullName:傳回本工作簿、檔案所儲存的路徑 + 檔名。
'ThisWorkbook.Name:傳回本工作簿、檔案所儲存的檔名。
'ActiveWindow.ActiveSheet.Name 或 ActiveSheet.Name 目前工作表名稱
work_book = ThisWorkbook.Name
'檔案檢查
If Dir("C:\stock", vbDirectory) = "" Then MkDir "C:\stock"
If Dir("C:\stock\analysis", vbDirectory) = "" Then MkDir "C:\stock\analysis"
If Dir("C:\stock\data", vbDirectory) = "" Then MkDir "C:\stock\data"
'For file_check = 1 To Workbooks.Count
'If Workbooks(file_check).Name = "single_suggest.xlsx" Then
'Windows("single_suggest.xlsx").Activate
'Application.DisplayAlerts = False
'Windows("single_suggest.xlsx").Close (vb = no)
'Application.DisplayAlerts = True
'Exit For
'End If
'Next file_check
'For file_check = 1 To Workbooks.Count
'If Workbooks(file_check).Name = "multi_suggest.xlsx" Then
'Windows("multi_suggest.xlsx").Activate
'Application.DisplayAlerts = False
'Windows("multi_suggest.xlsx").Close (vb = no)
'Application.DisplayAlerts = True
'Exit For
'End If
'Next file_check
For file_check = 1 To Workbooks.Count
check_1 = Right(Workbooks(file_check).Name, 4)
If check_1 = ".csv" Then
check_2 = Workbooks(file_check).Name
'Windows(check_2).Activate
Application.DisplayAlerts = False
Windows(check_2).Close (vb = yes)
Application.DisplayAlerts = True
End If
Next file_check
For file_check = 1 To Workbooks.Count
check_1 = Right(Workbooks(file_check).Name, 5)
If check_1 = ".xlsx" Then
check_2 = Workbooks(file_check).Name
'Windows(check_2).Activate
Application.DisplayAlerts = False
Windows(check_2).Close (vb = yes)
Application.DisplayAlerts = True
End If
Next file_check
'舊檔案刪除
If Len(Dir("C:\stock\*.*")) > 0 Then Kill "C:\stock\*.*"
'SetAttr "C:\stock\*.*", vbNormal ' 排除唯讀檔問題
If Len(Dir("C:\stock\data\*.*")) > 0 Then Kill "C:\stock\data\*.*"
'SetAttr "C:\stock\data\*.*", vbNormal ' 排除唯讀檔問題
If Len(Dir("C:\stock\analysis\*.*")) > 0 Then Kill "C:\stock\analysis\*.*"
'SetAttr "C:\stock\analysis\*.*", vbNormal ' 排除唯讀檔問題
Main_Menu (work_book)
End Sub

xyz987
04-06-2024, 06:52 PM
Dear sirs
fix last code, if use "for" will cause error, need change "for each"


Sub check_menu()
Dim wb As Workbook
'ThisWorkbook.Path:傳回本工作簿、檔案所儲存的路徑。
'ThisWorkbook.FullName:傳回本工作簿、檔案所儲存的路徑 + 檔名。
'ThisWorkbook.Name:傳回本工作簿、檔案所儲存的檔名。
'ActiveWindow.ActiveSheet.Name 或 ActiveSheet.Name 目前工作表名稱
work_book = ThisWorkbook.Name
'檔案檢查
If Dir("C:\stock", vbDirectory) = "" Then MkDir "C:\stock"
If Dir("C:\stock\analysis", vbDirectory) = "" Then MkDir "C:\stock\analysis"
If Dir("C:\stock\data", vbDirectory) = "" Then MkDir "C:\stock\data"
For each wb in application.workbooks
if Right(wb.Name, 4) = ".csv" or Right(wb.Name, 4) = "csv" then
Application.DisplayAlerts = False
wb.Close (vb = yes)
Application.DisplayAlerts = True
elseIf Right (wb.Name, 5) = ".xlsx" or Right(wb.Name, 5) = "xlsx" then
Application.DisplayAlerts = False
wb.Close (vb = yes)
Application.DisplayAlerts = True
End If
Next wb
'舊檔案刪除
If Len(Dir("C:\stock\*.*")) > 0 Then Kill "C:\stock\*.*"
'SetAttr "C:\stock\*.*", vbNormal ' 排除唯讀檔問題
If Len(Dir("C:\stock\data\*.*")) > 0 Then Kill "C:\stock\data\*.*"
'SetAttr "C:\stock\data\*.*", vbNormal ' 排除唯讀檔問題
If Len(Dir("C:\stock\analysis\*.*")) > 0 Then Kill "C:\stock\analysis\*.*"
'SetAttr "C:\stock\analysis\*.*", vbNormal ' 排除唯讀檔問題
Main_Menu (work_book)
End Sub

Aussiebear
04-06-2024, 07:06 PM
What is the error?

xyz987
04-15-2024, 09:22 AM
sorry, i just look this message, if use "For file_check = 1 To Workbooks.Count" , when it finish (close how many excel)then jump to other sub, it will cause how many close excel circle. like if it close three excel file. then when it finish, it will make three circle. but maybe it only error in my code, if you want to look, attach file is full file, you can refer it. sorry about my English not very well, maybe cause you confuse.