Consulting

Results 1 to 6 of 6

Thread: How to close all .csv or .xlsx type file

  1. #1
    VBAX Regular
    Joined
    Mar 2024
    Posts
    20
    Location

    How to close all .csv or .xlsx type file

    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
    Last edited by Aussiebear; 04-06-2024 at 01:08 AM. Reason: Added code tags o supplied code (yet again....)

  2. #2
    VBAX Mentor
    Joined
    Nov 2022
    Location
    The Great Land
    Posts
    338
    Location
    How to attach file: Reading and Posting Messages (vbaexpress.com), click Go Advanced below post edit window. To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  3. #3
    VBAX Regular
    Joined
    Mar 2024
    Posts
    20
    Location
    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
    Last edited by Aussiebear; 04-06-2024 at 01:11 AM. Reason: Yep.... Added code tags yet again

  4. #4
    VBAX Regular
    Joined
    Mar 2024
    Posts
    20
    Location
    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
    Last edited by Aussiebear; 04-06-2024 at 07:05 PM. Reason: Added code tags...... (yet again)

  5. #5
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,064
    Location
    What is the error?
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  6. #6
    VBAX Regular
    Joined
    Mar 2024
    Posts
    20
    Location
    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.
    Attached Files Attached Files

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •