Question

我不确定如何解决这个问题。我做了很多研究，但我发现的大多数答案都与我的需求有所不同。

我想要完成的是：

手动打开现有工作簿（wbAI），
启动宏，
使用msoFileDialogOpen查找并打开文件（调用此wb2），
将wb2文件名的部分存储（文件名中有一个日期）作为变量或字符串。（我不确定哪个更好用于此目的。也许我不需要存储它...），
将wb2文件名（日期）的一部分粘贴到wb1，
从wb2，
将数据粘贴到wb1，
格式化数据
对粘贴的数据使用VLOOKUP
关闭wb2而不保存
结束宏。

我的宏可以完成上面列出的每一步，除了第四和第五。一方面，我想知道我是如何追求这一点的，另一方面，我想知道它在我当前的代码中的位置。

为了举例说明我在说什么：让我们说在第三步中我打开一个名为“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 FUNCTION返回日期的LEFT 8个字符：

dateVar=left(wbSource.name, 8)

然后你可以把它放在你的手机中：

rangeVar.value=dateVar

希望能让你前进

菲利普

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

1 个答案: