返回列表 上一主題 發帖

[發問] EXCEL請益，開啟特定資料夾內，不特定檔名的.xlsx檔案

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2023-9-21 
1# 跳轉到 »
發表於 2021-8-23 08:06 | 顯示全部帖子
回復 1# zz0660

請測試看看，謝謝
Sub 選擇檔案可複選()
With Application.FileDialog(msoFileDialogOpen)
    .InitialFileName = "D:\"
    .AllowMultiSelect = True
    .Show
    fc = .SelectedItems.Count: If fc = 0 Then Exit Sub
    For x = 1 To fc
        FPath = .SelectedItems(x)
        Set WB = Workbooks.Open(FPath)
        With WB.Sheets(1)
            '需求程式
            
        End With
        WB.Close
    Next
End With
End Sub

TOP

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2023-9-21 
2#
發表於 2021-8-23 14:20 | 顯示全部帖子
回復 3# zz0660

資料夾路徑如下D:\AA\BB\CC\DD
假設日期今天日期2021/08/22，程式能不能開啟20210820-20210823的這個檔案?
>> 請再測試看看，謝謝

Sub test()
Dim Arr(), T$, d$, d1$, d2$, xY$, xM$, xD$
T = Date
Set fs = CreateObject("Scripting.FileSystemObject")
a = "D:\AA\BB\CC\DD"
Set f = fs.GetFolder(a)
Set fc = f.Files
For Each f1 In fc
    d = Split(Split(f1.Name, ")")(1), "-")(0)
    xY = Left(d, 4): xM = Mid(d, 5, 2): xD = Right(d, 2)
    d1 = DateSerial(xY, xM, xD)
    d = Split(Split(Split(f1.Name, ")")(1), "-")(1), ".")(0)
    xY = Left(d, 4): xM = Mid(d, 5, 2): xD = Right(d, 2)
    d2 = DateSerial(xY, xM, xD)
    If T >= d1 And T <= d2 Then
        ReDim Preserve Arr(n)
        Arr(n) = f1.Path
        n = n + 1
    End If
Next

If n > 0 Then
For i = 0 To n - 1
    Set WB = Workbooks.Open(Arr(i))
    '主程式需求
   
    WB.Close
Next
End If
End Sub

TOP

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2023-9-21 
3#
發表於 2021-8-23 16:36 | 顯示全部帖子
回復 5# zz0660

點擊按鈕會閃一下，就沒反應
>> 程式開啟檔案後就會直接關閉，因為沒有後續動作(沒有主程式需求)，所以只有閃一下，
我測試沒問題如附件，謝謝

擷取.PNG (134.61 KB)

擷取.PNG

TOP

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2023-9-21 
4#
發表於 2021-9-5 14:44 | 顯示全部帖子
回復 8# zz0660


  不會因為其他檔名而開啟不了檔案。
目前個人認為可能是Split，這邊的問題吧?  

>> 新增如下紅字，請再測試，謝謝
Sub test()
Dim Arr(), T$, d$, d1$, d2$, xY$, xM$, xD$
T = Date
Set fs = CreateObject("Scripting.FileSystemObject")
a = "D:\AA\BB\CC\DD"
Set f = fs.GetFolder(a)
Set fc = f.Files
For Each f1 In fc
    If UCase(Left(f1.Name, 3)) <> "L-M" Then GoTo 99
    d = Split(Split(f1.Name, ")")(1), "-")(0)
    xY = Left(d, 4): xM = Mid(d, 5, 2): xD = Right(d, 2)
    d1 = DateSerial(xY, xM, xD)
    d = Split(Split(Split(f1.Name, ")")(1), "-")(1), ".")(0)
    xY = Left(d, 4): xM = Mid(d, 5, 2): xD = Right(d, 2)
    d2 = DateSerial(xY, xM, xD)
    If T >= d1 And T <= d2 Then
        ReDim Preserve Arr(n)
        Arr(n) = f1.Path
        n = n + 1
    End If
99: Next

...
...

TOP

        靜思自在 : 【蒙蔽的自由】人常在什麼都可以自由自在的時候，卻被這種隨心所欲的自由蒙蔽，虛擲時光而毫無覺知。
返回列表 上一主題