Question

我想创建一个在文件中打开excel文件夹的宏。我遇到的唯一问题是我不能通过像这样的宏来做这件事：

Sub CopyDataFromWorksheet()

   Workbooks.Open ("dir\files\dashboard 24-01-2014.xls")

End Sub

因为我要打开的文件包含一个变量组件。它有一个固定的naam，仪表板，但也是一个日期，20 - 01 - 2014，它经常变化。所以我正在寻找代码：

打开文件夹
查找包含“Dashboard”的xls文件
打开它们。

有人想我应该如何编码吗？

亲爱的，

Marc

Answer 1

试试这个：

Sub loopdir()
Dim MyFile$, Fold$
'Dim FD As FileDialog
Dim WBCur As Workbook, WBFile As Workbook
Set WBCur = ActiveWorkbook

'''pick a folder with dialog
'Set FD = Application.FileDialog(msoFileDialogFolderPicker)
'With FD
'.Title = "Select a Folder"
'.AllowMultiSelect = False
'If .Show <> -1 Then Exit Sub
'Fold = .SelectedItems(1) & "\"
'End With
'Set FD = Nothing
'''or just
Fold = "<your folder here with \ in the end>"

MyFile = Dir(Fold & "dashboard*.xls*") 'last * for both xls and xlsx
Do While MyFile <> ""
    Workbooks.Open Filename:=Fold & MyFile
    Set WBFile = ActiveWorkbook
    '''your code here
    'Application.DisplayAlerts = False
    'WBFile.Close
    'Application.DisplayAlerts = True
    MyFile = Dir()
Loop
'Application.DisplayAlerts = True 'for sure
Set WBCur = Nothing
Set WBFile = Nothing
End Sub

Answer 2

这应该对你有用。

Sub openAllFiles()
yourPath="dir\files\"
file=Dir(yourPath & "Dashboard*.xls")
Do while file<>vbNullString
Workbooks.Open(yourpath & file)
file=Dir()
Loop
End Sub

Answer 3

认为您需要对代码进行非常小的更改：

Sub openAllFiles()

yourPath = "X:\SSC_HR\SENS\Bedrijfsbureau\Rapportages\sterren\MAANDELIJKSE RAPPORTAGES\UITDRAAI DB_MAANDELIJKS_DASHBOARD\"
file = Dir(yourPath & "Dashboard*.xls")
Do While file <> vbNullString
Workbooks.Open (yourPath & file)
file = Dir()
Loop
End Sub

workbooks.Open需要完整路径而不仅仅是文件名

Answer 4

很好的解决方案Alex。我把你的答案向前迈进了一步，而不是打开所有类似命名的文件。我需要打开最新的，同样命名的文件。所以我这样做了......

Dim newest As Date
Dim current As Date
Dim right_file As String
Dim rot_cnt As Integer
rot_cnt = 1

Dim my_path As String
Dim file_name As String
my_path = "C:\Path\To\File\Dir\"
file_name = Dir(my_path & "My-Similar-Files*.xlsm")

Do While file_name <> vbNullString
    If rot_cnt = 1 Then
        newest = FileDateTime(my_path & file_name)
    End If
    If rot_cnt >= 1 Then
        current = FileDateTime(my_path & file_name)
    End If
    If DateSerial(Year(current), Month(current), Day(current)) >= _
    DateSerial(Year(newest), Month(newest), Day(newest)) Then
        newest = FileDateTime(my_path & file_name)
        right_file = my_path & file_name
    End If
    file_name = Dir()
    rot_cnt = rot_cnt + 1
Loop

Workbooks.Open (right_file), UpdateLinks:=False, ReadOnly:=True

经过进一步测试后，这将使用上一次“实际”创建时间的保存时间，因此可能会返回不需要的结果。 BuiltinDocumentProperties（“创建日期”）也是创建日期的错误引导。如果有人复制工作簿，则克隆此值。为了在不必手动启用任何新引用的情况下获得正确的结果，我使用了它。

Dim oFS As Object
Dim StrFile As String
Dim rot_cnt As Integer
rot_cnt = 1

Dim current As Date
Dim newest As Date
Dim right_file As String

Dim my_path As String
Dim file_name As String
my_path = "C:\Path\To\File\Dir\"
file_name = "My-Similar-Files*.xlsm"

StrFile = Dir(my_path & file_name)
Do While Len(StrFile) > 0
    Set oFS = CreateObject("Scripting.FileSystemObject")
    If rot_cnt = 1 Then
        newest = oFS.GetFile(my_path & StrFile).DateCreated
    End If  
    If rot_cnt >= 1 Then
        current = oFS.GetFile(my_path & StrFile).DateCreated
    End If

'The Right(StrFile, 6) If parameter is because Dir() also gives the exact 
'string of file_name as one of the values which we don't want to process.
    If DateSerial(Year(current), Month(current), Day(current)) >= _
    DateSerial(Year(newest), Month(newest), Day(newest)) _
    And Right(StrFile, 6) <> "*.xlsm" Then
        newest = oFS.GetFile(my_path & StrFile).DateCreated
        right_file = my_path & StrFile
    End If

    StrFile = Dir
    Set oFS = Nothing
    rot_cnt = rot_cnt + 1
Loop

Workbooks.Open (right_file), UpdateLinks:=False, ReadOnly:=True

使用更改名称打开文件

4 个答案: