我有一个代码允许我在excel工作簿中打开多个文件,但是我不想手动选择我要打开的dat文件,而是希望能够循环我的代码以便它遍历我的所有文件并搜索名为p00001,p00002,p00003等的dat文件。有谁知道如何编辑我的代码来选择所有这些名为?
的文件我的代码是:
Sub ImportFiles()
Dim sheet As Worksheet
Dim total As Integer
Dim intChoice As Integer
Dim strPath As String
Dim i As Integer
Dim wbNew As Workbook
Dim wbSource As Workbook
Set wbNew = Workbooks.Add
'allow the user to select multiple files
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = True
'make the file dialog visible to the user
intChoice = Application.FileDialog(msoFileDialogOpen).Show
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'determine what choice the user made
If intChoice <> 0 Then
'get the file path selected by the user
For i = 1 To Application.FileDialog(msoFileDialogOpen).SelectedItems.Count
strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(i)
Set wbSource = Workbooks.Open(strPath)
For Each sheet In wbSource.Worksheets
total = wbNew.Worksheets.Count
wbSource.Worksheets(sheet.Name).Copy _
after:=wbNew.Worksheets(total)
Next sheet
wbSource.Close
Next i
End If
End Sub
答案 0 :(得分:0)
您需要向下钻取文件夹。您可以在下面看到示例。您需要做的就是如果Statment If InStr(File, ".dat") And InStr(File, "\p0") Then
调整此值,那么只有您想要的文件才会被打开。
Public sheet As Worksheet
Public total As Integer
Public intChoice As Integer
Public strPath As String
Public i As Integer
Public wbNew As Workbook
Public wbSource As Workbook
Sub main()
Set wbNew = Workbooks.Add
Dim FileSystem As Object
Dim HostFolder As String
HostFolder = "D:\test"
Set FileSystem = CreateObject("Scripting.FileSystemObject")
DoFolder FileSystem.GetFolder(HostFolder)
End Sub
Sub DoFolder(Folder)
Dim SubFolder
For Each SubFolder In Folder.SubFolders
DoFolder SubFolder
Next
Dim File
For Each File In Folder.Files
If InStr(File, ".dat") And InStr(File, "\p0") Then
strPath = File
Set wbSource = Workbooks.Open(strPath)
For Each sheet In wbSource.Worksheets
total = wbNew.Worksheets.Count
wbSource.Worksheets(sheet.Name).Copy _
after:=wbNew.Worksheets(total)
Next sheet
wbSource.Close
End If
Next
End Sub