vba - 使用 VBA 仅获取文件名/文件路径的一部分

Question

我不知道如何解决这个问题。我做了很多研究，但我找到的大多数答案与我需要的有点不同。

我想要完成的是:

1. 手动打开现有工作簿 (wbAI)，
2. 启动宏，
3. 使用 msoFileDialogOpen 查找并打开文件(将此称为 wb2)，
4. 将 wb2 文件名的部分(文件名中包含日期)存储为变量或字符串。 (我不确定哪个更适合这个目的。也许我不需要全部存储......)，
5. 将 wb2 文件名的一部分(日期)粘贴到 wb1 的某个单元格中，
6. 从 wb2 复制必要的数据，
7. 将数据粘贴到 wb1 中，
8. 设置数据格式，
9. 对粘贴的数据使用 VLOOKUP，
10. 关闭 wb2 而不保存
11. 结束宏。

我的宏可以执行上面列出的每一步，除了第四步和第五步。一方面，我想知道我需要如何实现这一点，另一方面，我想知道这适合我当前的代码。

举个例子来说明我正在讨论的内容:假设在第三步中我打开了一个名为“01.31.13 Group Names”的工作簿。文件路径来自 Sharepoint 站点，因此如下所示:

“https://company.com/team/teamone/_layouts/xlviewer.aspx?01.31.13%20Group%20Names%20.xlsm&Source=https.......”

如何仅挑选文件名/文件路径中的日期？

这是我的代码的开头:

Sub Test()

Dim lastRow As Long, i As Long
Dim ws As Worksheet
Dim wbSource As Workbook
Dim wbAI As Workbook
Dim vrtSelectedItem As Variant

Set wbAI = ActiveWorkbook
Application.ScreenUpdating = False 

With Application.FileDialog(msoFileDialogOpen)
    .InitialFileName = https://company.com/team/teamone & "\"
    .AllowMultiSelect = False
    .Show
    '  ******  Is this where the new code could be inserted? *******
   For Each vrtSelectedItem In .SelectedItems
   Set wbSource = Workbooks.Open(vrtSelectedItem)
   Next
   End With
   ' Check if the first cell contains data. If not then close file
   If Range("Profile!H9") = "" Then
        ActiveWorkbook.Close savechanges:=False
        ActiveWorkbook.Saved = False

欢迎任何建议!感谢您的宝贵时间!

编辑:这是我的代码在菲利普的建议后的样子:

Sub Test()

Dim lastRow As Long, i As Long
Dim ws As Worksheet
Dim wbSource As Workbook
Dim wbAI As Workbook
Dim vrtSelectedItem As Variant

Set wbAI = ActiveWorkbook
Application.ScreenUpdating = False 

With Application.FileDialog(msoFileDialogOpen)
    .InitialFileName = https://company.com/team/teamone & "\"
    .AllowMultiSelect = False
    .Show

   For Each vrtSelectedItem In .SelectedItems
   Set wbSource = Workbooks.Open(vrtSelectedItem)
   Next
   End With
   dateVar = Left(wbSource.Name, 8) '<~~~~ New code
   ' Check if the first cell contains data. If not then close file
   If Range("Profile!H9") = "" Then
        ActiveWorkbook.Close savechanges:=False
        ActiveWorkbook.Saved = False
   Else
        Sheets("Profile").Activate
        Range("H9:I" & Cells(Rows.Count, "H").End(xlUp).Row).Select
        Selection.Copy
        Windows("wbName").Activate
        Sheets("Sheet1").Activate
        Range("A2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Range("E1").Value = dateVar '<~~~ New code

Answer 1

从文件名中，您可以使用LEFT函数返回日期的左侧8个字符:

dateVar=left(wbSource.name, 8)

然后你可以将其放入你的单元格中:

rangeVar.value=dateVar

希望能让你继续前进

菲利普