內容為excel 2003的程式碼，請問各位大大如在2010版本該如何修改，謝謝

aaronprada

Public Sub FileSearch(Target)
'檔案搜尋用副程式
'With Application.FileSearch
     Application.FileSearch.NewSearch
     Application.FileSearch.LookIn = "E:\"
     Application.FileSearch.SearchSubFolders = True
     Application.FileSearch.Filename = Target
     Application.FileSearch.MatchTextExactly = True
     Application.FileSearch.FileType = msoFileTypeAllFiles
     If Application.FileSearch.Execute() = 1 Then
        Filegot = Application.FileSearch.FoundFiles(1)
        Exit Sub
     Else
        If Application.FileSearch.Execute() = 7 Then: Exit Sub
        If InStr(Target, "警報記錄.csv") > 0 Then: MsgBox "請將當日環控原始檔案放入光碟機" & vbCrLf & vbCrLf & "或確認 7 個環控原始檔名正確": End
        MsgBox "光碟內找不到或有兩個以上 " & Target & "，請指定檔案位置"
        Filegot = Application.GetOpenFilename(UCase(Right(Target, 3)) & " Files (*" & Right(Target, 4) & "),*" & Right(Target, 4)) '手動取檔
        If InStr(Filegot, Replace(Left(Target, Len(Target) - 4), "*", "")) = 0 Then: MsgBox "檔案選擇錯誤" & vbCrLf & vbCrLf & "請選擇" & Target: End
   
'End With
End Sub

Hsieh

1. Public Sub FileSearch(Target)
   
2. fd = "E:\" '指定光碟機
   
3. Filegot = Dir(fd & "*" & Target & "*") '找出含有Target之檔案名稱
   
4. Do Until Filegot = ""
   
5. cnt = cnt + 1 '計算類似檔名個數
   
6. Filegot = Dir
   
7. Loop
   
8. If cnt = 1 Then
   
9.   If InStr(Target, "警報記錄.csv") > 0 Then: MsgBox "請將當日環控原始檔案放入光碟機" & vbCrLf & vbCrLf & "或確認 7 個環控原始檔名正確": End
   
10.   Else
    
11.   MsgBox "光碟內找不到或有兩個以上 " & Target & "，請指定檔案位置"
    
12.   Filegot = Application.GetOpenFilename(UCase(Right(Target, 3)) & " Files (*" & Right(Target, 4) & "),*" & Right(Target, 4)) '手動取檔
    
13.   If InStr(Filegot, Replace(Left(Target, Len(Target) - 4), "*", "")) = 0 Then: MsgBox "檔案選擇錯誤" & vbCrLf & vbCrLf & "請選擇" & Target: End
    
14. End If
    
15. End Sub

複製代碼

回復 1# aaronprada
試試看