Question

我写的宏工作正常，直到我碰巧将文件路径更改为相对文件路径。

这是实际的宏：

Public Sub refreshXLS()
    Dim fso As Object
    Dim folder As Object
    Dim file As Object
    Path = ThisWorkbook.Path & "\requiredSource\TestData1.xlsm"
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(Path)

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .EnableEvents = False
        .AskToUpdateLinks = False
    End With

    For Each file In folder.Files
        If Right(file.Name, 4) = "xlsx" Or Right(file.Name, 3) = "xls" Then
            Workbooks.Open Path & file.Name
            ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources
            ActiveWorkbook.Close True
         End If
    Next

        With Application
        .DisplayAlerts = False
        .ScreenUpdating = True
        .EnableEvents = True
        .AskToUpdateLinks = False
    End With
End Sub

我将其更新为：

Public Sub refreshXLS()

    Dim xlApp
    Dim xlBook
    Dim fso As Object
    Dim folder As Object
    Dim file As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim fullpath
    fullpath = fso.GetAbsolutePathName(".")
    Set fso = Nothing
    Set xlApp = CreateObject("Excel.Application")
    Path = xlApp.Workbooks.Open(fullpath & "\TestData1.xlsm")
    Set folder = fso.GetFolder(Path)

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .EnableEvents = False
        .AskToUpdateLinks = False
    End With

    For Each file In folder.Files
        If Right(file.Name, 4) = "xlsx" Or Right(file.Name, 3) = "xls" Then
            Workbooks.Open Path & file.Name
            ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources
            ActiveWorkbook.Close True
         End If
    Next

        With Application
        .DisplayAlerts = False
        .ScreenUpdating = True
        .EnableEvents = True
        .AskToUpdateLinks = False
    End With
End Sub

我也尝试过使用：

Workbooks.Open FileName:= ThisWorkbook.Path & "\TestData1.xlms".

这也无济于事。

Answer 1

您的代码无法正常工作，因为您更改了变量Path。

您放置Path = xlApp.Workbooks.Open(fullpath & "\TestData1.xlsm")，这意味着路径现在是工作簿对象，而不再是字符串。

我建议你开始使用Option Explicit作为习惯。在VBE中，选项 - ＆gt;勾选需要变量声明。

Answer 2

Public Sub refreshXLS()
    Dim fso As Object
    Dim file As Object
    Dim extension As String

    Set fso = CreateObject("Scripting.FileSystemObject")

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .EnableEvents = False
        .AskToUpdateLinks = False
    End With

    For Each file In fso.GetFolder(ThisWorkbook.Path).Files
        extension = LCase(fso.GetExtensionName(file.Path))
        If extension = "xlsx" Or extension = "xls" Then
            With Workbooks.Open(file.Path)
                .UpdateLink Name:=.LinkSources
                .Close True
            End With
        End If
    Next

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = True
        .EnableEvents = True
        .AskToUpdateLinks = False
    End With
End Sub

这将处理存储当前xlsm文件的同一文件夹中的所有文件。如果要处理的文件位于requiredSource文件夹下，则应将GetFolder更改为

For Each file In fso.GetFolder(fso.BuildPath(ThisWorkbook.Path, "RequiredSource")).Files

已修改以适应评论

vbs文件可能类似（假设前一个refreshXLS在模块内）

Option Explicit 

Const macroWorkbook = "TestData1.xlsm"
Const macroName = "refreshXLS"

Dim fso
    Set fso = WScript.CreateObject("Scripting.FileSystemObject")

Dim workbook    
    With CreateObject("Excel.Application") 
        Set workbook = .Workbooks.Open(fso.BuildPath( _ 
            fso.GetFile( WScript.ScriptFullName ).ParentFolder.Path _ 
            , macroWorkbook _ 
        ))
        .Application.Run "'" & Replace(workbook.Name, "'", "''") & "'!" & macroName
        .ActiveWorkbook.Close
        .Quit
    End With 

    WScript.Quit

我的VBS脚本正在查找错误目录中的文件

2 个答案: