vba 打开更改名称的文件

Open a file with changing name

提问by user181796

I want to create a macro which open an excel folder in a file. Only problem I run into now is that I cant do this normally by a macro like:

我想创建一个宏，在文件中打开一个 excel 文件夹。我现在遇到的唯一问题是我不能通过像这样的宏正常执行此操作：

Sub CopyDataFromWorksheet()

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

End Sub

Because the file I want to open contains a variable component. It has a fixed naam, dashboard, but also a date, 20 - 01 - 2014, which changes frequently. So I'm looking for code which:

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

• Open a folder
• Looks for xls files containing "Dashboard"
• Open them.

• 打开文件夹
• 查找包含“仪表板”的 xls 文件
• 打开它们。

Anybody thoughts on how I should code this?

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

Dear regards,

亲爱的问候，

Marc

马克

回答by Alex

Think you just need a very small change to your code:

认为您只需要对代码进行很小的更改：

Sub openAllFiles()

yourPath = "<your_file_path_ends_with\>"
file = Dir(yourPath & "Dashboard*.xls")
Do While file <> vbNullString
Workbooks.Open (yourPath & file)
file = Dir()
Loop
End Sub

workbooks.Open needs the full path instead of just the file name.

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

回答by PPh

try this:

尝试这个：

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

回答by bmgh1985

This should work OK for you.

这应该适合你。

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

回答by SM177Y

Nice solution Alex. I took your answer one step further and a little bit to the side :) Instead of opening all similarly named files. I needed to open the Newest, similarly named file. So I did this...

很好的解决方案亚历克斯。我把你的答案更进一步，稍微偏了一点:) 而不是打开所有类似命名的文件。我需要打开最新的，类似命名的文件。所以我做了这个...

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

After further testing this uses the last save time over the "real" creation time so it may return unwanted results. BuiltinDocumentProperties("Creation Date") is also a false lead to creation date. This value is cloned if someone copies the workbook. To achieve the proper result without having to manually enable any new references, I used this.

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

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