从源文件名更改的外部源导入

Posted 2023-05-07

【中文标题】从源文件名更改的外部源导入

【英文标题】：importing from an external souce where source filename changes

【发布时间】：2016-06-02 12:23:58

【问题描述】：

如果这是一个简单的问题，请原谅我，我还在学习..

我有一个 Excel 文件，它获取数据并执行分析以组成图表。现在更新的方法是从其他 2 个数据源手动复制和粘贴。我可以轻松地创建一个宏来导入第一个源，因为数据位置/文件名始终相同。第二个来源比较棘手，因为该文件有一些标准化的命名约定，但添加了一个日期，因为它每周刷新一次，每周一或周二。有没有办法自动从外部源（sharepoint 库）中提取数据并告诉它找到最新版本？是通过了解文件名中添加的日期约定，还是通过修改日期或其他标准的其他方式？该文件与以前的存档副本一起保存。我不拥有报告、sharepoint 站点或保存它的库，因此我无法影响这些因素 :(。感谢任何帮助，我可以提供更好的详细信息和解释。

【问题讨论】：

日期的命名约定是什么？

您可能还想查看FileDateTime(filepath)，您可以使用它来查找文件夹中的最新文件。示例：xl-central.com/open-the-latest-file-in-a-folder.html

【参考方案1】：

我知道有两种基本方法，或者允许用户通过对话框选择文件，或者使用“Dir”功能查找日期最近的文件。

第一种方法（我经常使用的代码）：

Public Function ChooseOpenFile() As String

Dim strSlash As String

If InStr(1, ActiveWorkbook.Path, "/") > 0 Then
    strSlash = "/"
Else
    strSlash = "\"
End If

With Application.FileDialog(msoFileDialogOpen)
        .Title = "Select the first file to open in series:"
        .InitialFileName = Replace(ActiveWorkbook.Path, "http:", "", 1) & strSlash
        Call .Filters.Clear
        Call .Filters.Add("Excel Files Only", "*.xls, *.xlsx, *.xlsb")

        'only allow the user to select one file
        .AllowMultiSelect = False
        'make the file dialog visible to the user
        intChoice = .Show
        'determine what choice the user made
            If intChoice <> 0 Then
                'get the file path selected by the user
                ChooseOpenFile = .SelectedItems(1)
            End If
End With

End Function

至于第二种方法，只要您已经可以通过编程方式访问该文件夹，您就可以构建一个循环来循环文件，从每个文件中提取日期，测试是否比以前的版本更新并存储文件名要退出循环的最新版本。

Function MostRecentFile() As String

Dim dateTest As Date
Dim dateRecent As Date

Dim strMyFile As String
Dim strMyFolder As String
Dim strCurrentFile As String
Dim strSlash As String

strMyFolder = ThisWorkbook.Path
    If InStr(1, strMyFolder, "/") > 0 Then
        strSlash = "/"
    Else
        strSlash = "\"
    End If

strMyFile = Dir(Replace(strMyFolder, "http:", "") & strSlash & "*.xls*")

Do While strMyFile <> ""
    'Modify this line (number of characters and extension to replace) as needed.
    dateTest = CDate(Replace(Right(strMyFile, 15), ".xls*", ""))
    If dateTest > dateRecent Then
        dateRecent = dateTest
        strCurrentFile = strMyFile
    End If
    Stop
    Dir
Loop

MostRecentFile = strCurrentFile

End Function

【参考方案2】：

您可以浏览到该文件。

Sub GetOpenFile() 
Dim fileStr As String
fileStr = Application.GetOpenFilename()
If fileStr = "False" Then Exit Sub
Workbooks.Open fileStr
End Sub

如果您想要某种自动化解决方案，根据您的系统日期，例如下周一或周二，您可以让机器计算出来，并将结果传递给文件路径中的适当字符串。

Sub NameAsNextMon()
Dim K As Integer
Dim dteMon As Date
Dim tempName As Variant

K = Weekday(Now)
dteMon = Now() + (9 - K)
tempName = Year(dteMon) & "-" & Month(dteMon) & "-" & Day(dteMon) & ".xls"
Do
fName = Application.GetSaveAsFilename(tempName)
Loop Until fName <> False
ActiveWorkbook.SaveAs Filename:=fName
End Sub