Question

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

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

Answer 1

我知道有两种基本方法，或者允许用户通过对话框选择文件，或者使用＆＃34; Dir＆＃34;用于查找具有最新日期的文件。

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

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

Answer 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

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

2 个答案: