Question

我希望宏搜索名为＆＃34; OTIF＆＃34; [...]的打开文件。当宏找到工作簿时，它应该将文件名粘贴到工作表中＃14; sheet1＆＃34;单元格A1在另一个工作簿（wb2）中。不知怎的，它不起作用。

Sub Filename()

Dim Wb1 As Workbook, wb2 As Workbook, wB As Workbook

For Each wB In Application.Workbooks
    If Left(wB.Name, 4) = "OTIF" Then
        Set Wb1 = wB
        Exit For
    End If
Next

If Not Wb1 Is Nothing Then
    Set wb2 = ThisWorkbook
End If

With wb2.Sheets("AAA")
    .Range("A1").Value = Dir(Wb1.FullName)
End With

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

MsgBox "DONE!"

End Sub

Answer 1

您希望通过

实现目标

Dir(Wb1.FullName)

这是你问题的根源。只需删除Dir和()及其正在运行的.Range("A1").Value = Wb1.FullName

即可

Answer 2

完整编辑的代码：

Option Explicit

Sub Filename()

Dim Wb1 As Workbook, wb2 As Workbook, wB As Workbook
Dim ws As Worksheet

Set wb2 = ThisWorkbook

On Error Resume Next
Set ws = wb2.Worksheets("AAA")
On Error GoTo 0
If ws Is Nothing Then ' make sure "AAA" sheet exists
    MsgBox "AAA sheet does not exist, or has been renamed", vbCritical
    Exit Sub
End If

For Each wB In Application.Workbooks
    If Left(wB.Name, 4) = "OTIF" Then
        ' for DEBUG ONLY
        ws.Range("A1").Value = wB.Sheets.Count

        ' 2nd Debug option
        ws.Range("A1").Value = "Test"

       ' ws.Range("A1").Value = wB.Name

        MsgBox "DONE!"
        Exit For
    End If
Next

End Sub

Answer 3

我看了你的代码，它可以简化如下。

Sub Filename()
Dim wB As Workbook
For Each wB In Application.Workbooks
    If Left(wB.Name, 4) = "OTIF" Then
        ThisWorkbook.Sheets("AAA").Range("A1").Value = wB.FullName
        Exit For
    End If
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "DONE!"
End Sub

Excel VBA - 将工作簿名称从on复制到另一个

3 个答案: