就是讀取檔案夾里的EXCEL檔案內容,賦值到運行VBA的的EXCEL檔案里。
下面是代碼,本人不是太懂代碼,上網查了一下,EXCEL2010不讓用Application.FileSearch,
那么怎么才能把Application.FileSearch代替掉啊。求高手指點,越詳細越好,本人是菜鳥。
謝謝了!!!
Private Sub CommandButton1_Click()
Dim fileName As String
Dim kenSaKuFlg As String
Dim strKey As String
Dim oFileSearch As Object
Dim w_strTemp As String
Dim book As String
Dim rowNum As Integer
Dim sFileAllName As String
Dim sName() As String
Dim maxRowNum As Integer
Dim sFilePath As String
Dim sNum As String
Dim bug As String
Dim NewXlApp As Excel.Application
Dim num As Integer
sFilePath = Trim(TextBox1.Text)
Set oFileSearch = Application.FileSearch
If sFilePath = "" Then
MsgBox "検索フォルダを入力してください。"
Exit Sub
End If
With oFileSearch
.NewSearch
.FileType = msoFileTypeAllFiles '全て類型のファイル。
.LookIn = sFilePath 'ファイルタを指定する。
.fileName = "*.xls" 'ファイルを指定する。
.SearchSubFolders = False
.Execute
'ファイルを存在する。
For i = 1 To .FoundFiles.Count
num = 0
Set NewXlApp = New Excel.Application
sFileAllName = .FoundFiles(i)
sName = Split(.FoundFiles(i), "\")
sFileName = sName(UBound(sName))
NewXlApp.Workbooks.Open sFileAllName
sNum = NewXlApp.Sheets(1).Range("K6").Value
bug = NewXlApp.Sheets(1).Range("O18").Value
a1 = NewXlApp.Sheets(1).Range("O19").Value
a2 = NewXlApp.Sheets(1).Range("N27").Value
NewXlApp.Quit
Set NewXlApp = Nothing
Cells(i + 1, 8) = sFileName
Cells(i + 1, 9) = sNum
Cells(i + 1, 10) = bug
Cells(i + 1, 11) = a1
Cells(i + 1, 12) = a2
Next
End With
MsgBox "処理が終了します、確認してください。"
End Sub
uj5u.com熱心網友回復:
看來偶out啦.........我的電腦還是2003+2007
uj5u.com熱心網友回復:
Office 2007 也不支持這個。
不過,看到你用到了 .SearchSubFolders = False ,那就很好辦了。
不用搜索子目錄,很好處理。可以寫一個很簡單的函式,來替代它。
Private Function SearchFiles(sPath As String, sFileName As String) As String()
Dim aList() As String
Dim sTemp As String
Dim i&, k&, U As Long
If (Right$(sPath, 1) = "\") Then
sTemp = sPath & sFileName
Else
sTemp = sPath & "\" & sFileName
End If
k = -1: U = 31
ReDim aList(U)
sTemp = Dir$(sTemp, 7&)
Do
If (Len(sTemp) = 0) Then Exit Do
k = k + 1
If (k > U) Then
U = U + 8
ReDim Preserve aList(U)
End If
aList(k) = sTemp
sTemp = Dir$()
Loop
If (k >= 0) Then ReDim Preserve aList(k)
SearchFiles = aList
End Function
' 應用示例:
Private Sub test()
Dim aFiles() As String
Dim i&
' 搜索 “D:\檔案” 中的所有 .xls 檔案:
aFiles = SearchFiles("D:\檔案", "*.xls")
For i = 0 To UBound(aFiles)
Debug.Print i, aFiles(i)
Next
End Sub
uj5u.com熱心網友回復:
如果你可以搜到filesearch棄用,那應該可以看到可以用application.findfile方法替代。其實兩個功能是一樣的,都是打開指定的檔案,并回傳給一個application變數。
uj5u.com熱心網友回復:
學習了
轉載請註明出處,本文鏈接:https://www.uj5u.com/gongcheng/134053.html
標籤:VBA
上一篇:請教高手——VBA函式求助
