Question

结束游戏：用户保存的工作簿将打开并镜像目标文件中的代码。

我正在尝试创建一个具有Excel前端和Access后端的简单VBA应用程序。将有多个用户可以选择将前端Excel文件保存在他们想要的任何地方。

我想知道在我需要推送更新时能够在所有用户实例中更新宏的最有效方法。

基本上，我想在Workbook_open上镜像来自“全局”文件的代码。在过去，我确实设置了代码来打开单独的工作簿并运行代码（dim x as workbook，open，app.runmacro等等。）但我认为这不是最有效的方式这样做。

Answer 1

为此想到了四种可能的解决方案（除了您选择使用中间工作簿），可能还有其他解决方案：

将工作簿视为纯粹的接口，并将代码移动到访问数据库并让它接受Workbook作为参数if 需要。优点是代码可以保持在一个放置（Access），但它有两个主要缺点。每个用户需要安装Access才能实例化调用方法的应用程序，它会锁定你的 “接口” - 即改变它调用Access宏的方式仍需要工作簿更新。
创建规范工作簿并让用户工作簿版本检查打开时反对规范工作簿。如果版本是不同，打开新的，将所有数据移动到它，删除旧的，并将新副本保存为与旧副本相同的文件名。这种方法的主要缺点是确保旧代码不会运行可能很困难，正如您所需要的那样采取措施防止用户可以中止的情况更新过程仍然有旧代码的工作副本。
自动化VBE（有关实施细节，请参阅this answer - 关于如何做到这一点有很多资源）。取决于如何你想这样做，你可以将当前模块存储为文件并导入它们，或将代码存储在数据库本身和查询它。这种方法的主要缺点是 VBE可能会对改变实际运行的代码变幻无常。我不确定我是否相信它会改变它自己的实现。您还需要允许在每个用户的安全性中访问VBE 设置，可能会造成安全威胁。
然后将工作簿本身的位置存储在数据库中使用外部代码推出更新的副本。工作手册会打开时报告它的文件路径，如果它尚未记录在数据库中，检查它是否是最新版本，然后为自己写一条记录。这有缺点只能告知用户他们没有当前的如果他们（例如）在资源管理器中移动工作簿并且直到推后才打开它。

请注意，这些都是“pull”类型，而不是“push”类型解决方案，但最后一个除外。无论您使用哪种方法进行版本检查，任何推送解决方案都将分享4号的缺点 - 没有可靠的方法来确保推送捕获所有无效的版本。

Answer 2

以下是一种向用户推送更新的方法;要使用此方法，所有用户都需要访问本地共享驱动器。

   'SAVE THIS TO A STANDARD MODULE
    Option Explicit
    Option Compare Text


    'CHANGE TO SET MACROS TO PRODUCTION (WILL NOT ALLOW UPDATES TO HAPPEN WHILE FALSE)
    '[WARNING, DO NOT SEND TO USERS WHILE FALSE, OTHERWISE FORCE UPDATE WILL HAVE TO BE APPLIED.]
    Private Const inProduction As Boolean = False

    'FOLDER PATHS (MUST UPDATE!)
    Private Const SharedFolderPath As String = "S:\SharedFolder\"
    Private Const BackupFolderPath As String = "C:\BackupFolder\"
    Private Const UsersFolderPath As String = "C:\UsersFolder\"

    'FILE NAMES
    Private Const WorkbookFileName As String = "test.xlsb"
    Private Const VersionFileName As String = "version.txt"
    Private Const TesterVersionFileName As String = "testerVersion.txt"
    Private Const UpdateNotes As String = "README.txt"
    Private Const UserLog As String = "UserLog.txt"


    'DEVELOPER\TESTER LIST (MUST BE COMMA SEPERATED WITH NO SPACES, CALLED FROM 'isTester()' 'isDeveloper()'
    Public Const Developers As String = "yourcomputername"
    Public Const Testers As String = "computuername,testuser2,testuser3,testuser4"

    'USERS VERSION NUMBER [WARNING: FILE NAMES ARE SAVED BASED ON THE TesterVersionNumber]
    Public Const VersionNumber As String = "0.0.0"
    Public Const TesterVersionNumber As String = "0.0.0"


    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' PACKAGE MUST INCLUDE: cFileSystemObject
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    '==================================================================================
    ' SAVES THISWORKBOOK VERSION TO SHARED AND BACKUP FOLDERS //(RUN FROM VISUAL BASIC)
    '==================================================================================
    Private Sub SaveUpdatedVersion()

        'DECLARE VARIABLES
        Dim fso As cFileSystemObject
        Dim NotesResult As String
        Dim TextFileResult As VbMsgBoxResult

        'INITIAL SET
        Set fso = New cFileSystemObject

        ''''''''''''''''''''''''''''''''''''''''''''''''
        'CHECK TO MAKE SURE FOLDERS EXIST
        ''''''''''''''''''''''''''''''''''''''''''''''''
        If fso.FolderExists(BackupFolderPath) And fso.FolderExists(SharedFolderPath) Then


            'CHECK TO SEE IF USER IS A DEVELOPER
            If IsDeveloper = False Then
                MsgBox "You are currently not a developer. Please add your name to the const 'Developers'", vbCritical
                Exit Sub
            End If

            'SAVE THISWORKBOOK (TO INSURE ANY UPDATES ARE APPLIED)
            ThisWorkbook.Save


            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            ' SAVE UPDATED FILES SECTION
            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            If fso.FileExists(SharedFolderPath & TesterVersionNumber & " " & WorkbookFileName) Then
                If MsgBox("[WARNING FILE EXISTS] Are you sure you would like to overwrite it?", vbYesNo) = vbNo Then
                    Exit Sub
                End If
            End If

            'SAVE FILE TO SHARED LOCATION - NOTE IT WILL ALWAYS BE SAVED WITH THE TESTER VERSION #
            fso.CopyFile ThisWorkbook.FullName, SharedFolderPath & TesterVersionNumber & " " & WorkbookFileName, True

            'SAVE FILE TO BACKUP LOCATION
            fso.CopyFile ThisWorkbook.FullName, BackupFolderPath & TesterVersionNumber & " " & WorkbookFileName, True

            'UPDATE VERSION #'S. NOTE: UPDATE VERSION # CONST IN ORDER TO PUSH OUT UPDATES
            fso.WriteToTextFile SharedFolderPath & VersionFileName, VersionNumber
            fso.WriteToTextFile SharedFolderPath & TesterVersionFileName, TesterVersionNumber



            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            ' ADD NOTES ABOUT THE UPDATE
            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            NotesResult = InputBox("Update notes", "Notes")
            NotesResult = "[" & TesterVersionNumber & "] (" & Now & ") " & NotesResult & vbNewLine & fso.ReadTextFile(SharedFolderPath & UpdateNotes)
            fso.WriteToTextFile SharedFolderPath & UpdateNotes, NotesResult

            'UPDATES A LOG OF CURRENT
            LogVersionNumber


            'SUCCESS!!
            Debug.Print "Succefully pushed out updates!"

        Else

            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            'FOLDER(S) DO NOT EXIST [ERROR]. OPTIONAL CREATE FOLDERS
            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            If MsgBox("[ERROR] Folder(s) do not exist in order to overwrite updated Version. Would you like to create them?", vbYesNo) = vbYes Then

                'CREATE FOLDERS
                If fso.CreateFolderPath(BackupFolderPath) = True And fso.CreateFolderPath(SharedFolderPath) = True Then

                    'SUCCESS RERUN THIS SUB TO ADD FILES
                    MsgBox "Folders were succesfully created!", vbInformation
                    SaveUpdatedVersion

                Else
                    MsgBox "[ERROR Creating Folders] for unknown reasons the folders could not be created.", vbCritical
                End If


            End If

        End If

    End Sub


    '========================================================================
    ' CHECKS FOR UPDATES //CALLED FROM Workbook_Open EVENT
    '
    ' PACKAGE INCLUDES: LogVersionNumber(DELETE IF USING IN ANOTHER WORKBOOK)
    '========================================================================
    Public Sub CheckForUpdates(Optional ForceUpdate As Boolean = False)

        'DECLARE VARIABLES
        Dim fso As New cFileSystemObject
        Dim WB As Workbook
        Dim WbName As String
        Dim sTesterVersion As String
        Dim sVersion As String

        'CHECK TO SEE IF CODE IS READY TO GO INTO PRODUCTION (inProduction IS A CONST)
        If ForceUpdate = False Then
            If inProduction = False Then
                Debug.Print "Currently the 'CheckForUpdates' Macro is turned off. To start updates, set the const inProduction = True "
                Exit Sub
            End If
        End If

        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' CHECK TO SEE IF THISWORKBOOK IS SAVED IN CORRECT PATH.
        ' (NEEDED FIRST, JUST IN CASE USER OPENS THE VERSION THAT IS SAVED ON THE SHARED DRIVE.
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        If ThisWorkbook.FullName <> UsersFolderPath & WorkbookFileName Then


            'CHECK IF USERS FOLDER EXITS
            If Not fso.FolderExists(UsersFolderPath) Then

                'DOES NOT EXIST, CREATE FOLDER PATH
                If fso.CreateFolderPath(UsersFolderPath) = False Then

                    'UNABLE TO CREATE FOLDER PATH
                    MsgBox "[ERROR CREATING FOLDER PATH] '" & UsersFolderPath & "' could not be created.", vbCritical
                    Exit Sub

                End If

            End If

            'CHECK TO SEE IF WORKBOOK EXISTS, IF SO IF IT IS OPEN
            If fso.FileExists(UsersFolderPath & WorkbookFileName) Then

                'CHECK TO SEE IF WORKBOOK IS ALREADY OPEN
                Set WB = Workbooks(WorkbookFileName)
                If Not WB Is Nothing Then
                    Debug.Print "[ERROR] WORKBOOK ALREADY EXISTS AND IS ALREADY OPEN."
                    ThisWorkbook.Close False
                    Exit Sub
                End If

            End If

            'SAVE THISWORKBOOK TO USERS PERSONAL FOLDER
            Application.DisplayAlerts = False
            ThisWorkbook.SaveAs UsersFolderPath & WorkbookFileName
            Application.DisplayAlerts = True
        End If


        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' CHECK IF SHARED FILES EXISTS THAT ARE NEEDED TO UPDATE FROM
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        If Not fso.FileExists(SharedFolderPath & WorkbookFileName) And Not fso.FileExists(SharedFolderPath & VersionFileName) And Not fso.FileExists(SharedFolderPath & TesterVersionFileName) Then

            'FILES DON'T EXIST
            MsgBox "[ERROR UPDATING] UPDATED FILES NOT FOUND, OR USER DOESN'T HAVE ACCESS", vbCritical
            Exit Sub

        End If

        'INSURE VERSION FILES EXIST (AS WELL AS STORE THE FILE NAMES IN A LOCAL VARIABLE)
        sTesterVersion = SharedFolderPath & fso.ReadTextFile(SharedFolderPath & TesterVersionFileName) & " " & WorkbookFileName
        sVersion = SharedFolderPath & fso.ReadTextFile(SharedFolderPath & VersionFileName) & " " & WorkbookFileName

        If Not fso.FileExists(sTesterVersion) Or Not fso.FileExists(sVersion) Then
            Debug.Print "Tried to update. Version File(s) not found."
            Exit Sub
        End If


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' CHECK FOR UPDATES FOR TESTERS (THEY HAVE THEIR OWN VERSION #)
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        If isTester And fso.ReadTextFile(SharedFolderPath & TesterVersionFileName) <> TesterVersionNumber Then
            ForceUpdate = True
        End If


        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' CHECK VERSION #'S TO SEE IF THERE ARE ANY UPDATES. (OPTIONAL FORCED UPDATE)
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        If fso.ReadTextFile(SharedFolderPath & VersionFileName) <> VersionNumber Or ForceUpdate = True Then


            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            'DEVELOPER WARNING (DOUBLE CHECK TO MAKE SURE NOT TO OVERRIDE ANY CHANGES TO CODE.)
            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            If IsDeveloper Then
                If MsgBox("[WARNING] You are a developer, would you like to apply updates?", vbYesNo) = vbNo Then
                    Exit Sub
                End If
            End If


            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            ' UPDATE SECTION - CHANGES THISWORKBOOK NAME TO ALLOW THE UPDATED VERSION TO BE SAVED
            ' IN ITS ORIGINAL PLACE.
            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

            'CHANGE THE NAME OF CURRENT WORKBOOK
            On Error GoTo ErrorSaveAsCatch
            Application.DisplayAlerts = False
            ThisWorkbook.SaveAs UsersFolderPath & "TEMP" & WorkbookFileName, xlReadOnly
            Application.DisplayAlerts = True


            'COPY UPDATED FILE OVER THE OLD FILE LOCATION
            On Error GoTo ErrorCatch
            If isTester = True Then
                fso.CopyFile sTesterVersion, UsersFolderPath & WorkbookFileName, True
             Else
                fso.CopyFile sVersion, UsersFolderPath & WorkbookFileName, True
            End If

            'SHARED TEXT FILE THAT TRACKS USERS VERSION NUMBERS (REMOVE FOR OPEN SOURCE CODE)
            LogVersionNumber

            'OPEN THE NEW FILE LOCATION
            Application.EnableEvents = False
            Workbooks.Open UsersFolderPath & WorkbookFileName
            Application.EnableEvents = True

            MsgBox "Updates Applied!", vbInformation


            ''''''''''''''''''''''''''''''''''''''''''''''''''''
            'DELETE THE CURRENT WORKBOOK (OLD TEMP VERSION)
            ''''''''''''''''''''''''''''''''''''''''''''''''''''
            With ThisWorkbook
                .Saved = True
                .ChangeFileAccess xlReadOnly
                 Kill .FullName
                .Close False
            End With

        End If

        Exit Sub

    ErrorSaveAsCatch:
        Application.DisplayAlerts = False
        ThisWorkbook.SaveAs UsersFolderPath & WorkbookFileName
        Application.DisplayAlerts = True

    ErrorCatch:

    End Sub

  '==============================================================================
    ' LOG TO KEEP TRACK OF WHAT VERSION NUMBERS USERS HAVE
    '==============================================================================
    Public Function LogVersionNumber() As Boolean

        Dim fso As New cFileSystemObject

        On Error GoTo ErrorCatch

        If fso.CreateFolderPath(SharedFolderPath & UserLog) = False Then GoTo ErrorCatch

        If isTester = True Then
            fso.KeyValueWrite SharedFolderPath & UserLog, Environ("Username"), "[" & fso.ReadTextFile(SharedFolderPath & TesterVersionFileName) & "]-(" & Now & ")"
        Else
            fso.KeyValueWrite SharedFolderPath & UserLog, Environ("Username"), "[" & fso.ReadTextFile(SharedFolderPath & VersionFileName) & "]-(" & Now & ")"
        End If

        LogVersionNumber = True

        Exit Function
    ErrorCatch:
        Debug.Print "[ERROR IN LOG VERSION NUMBER]"

    End Function

    '======================================================================
    ' RETURN TRUE IF THE COMPUTER NAME IS STORED IN THE CONSTANT 'Testers'
    '======================================================================
    Public Function isTester() As Boolean

        'INITIAL DECLARE
        Dim CurrentUser As String
        Dim TesterList As Variant
        Dim I As Integer

        'INITIAL SET
        On Error GoTo CatchError
        CurrentUser = Environ("Username")
        TesterList = Split(Testers, ",")

        'LOOP ARRAY LOOKING FOR MATCH
        For I = LBound(TesterList, 1) To UBound(TesterList, 1)

            If TesterList(I) = CurrentUser Then
                isTester = True
                Exit Function
            End If

        Next I

        'ERROR HANDLING
    CatchError:

    End Function

    '========================================================================
    ' RETURN TRUE IF THE COMPUTER NAME IS STORED IN THE CONSTANT 'Developers'
    '========================================================================
    Public Function IsDeveloper() As Boolean

        'INITIAL DECLARE
        Dim CurrentUser As String
        Dim DeveloperList As Variant
        Dim I As Integer

        'INITIAL SET
        On Error GoTo CatchError
        CurrentUser = Environ("Username")
        DeveloperList = Split(Developers, ",")

        'LOOP ARRAY LOOKING FOR MATCH
        For I = LBound(DeveloperList, 1) To UBound(DeveloperList, 1)

            If DeveloperList(I) = CurrentUser Then
                IsDeveloper = True
                Exit Function
            End If

        Next I

        'ERROR HANDLING
    CatchError:

    End Function

以下是运行各种文件系统例程的类模块。

'SAVE THIS TO A CLASS MODULE, NAME IT: cFileSystemObject
Option Explicit
Option Compare Text

Private pFSO As Object
Private pTS As Object

Public Enum IOMode
    ForReading = 1
    ForWriting = 2
    ForAppending = 8
End Enum

'INITIALIZE EVENT
Private Sub Class_Initialize()
    Set pFSO = CreateObject("Scripting.FileSystemObject")
End Sub


'====================================================================
' retrive a value of a key property
'====================================================================
Public Function KeyValueRead(TextFilePath As String, Key As String, Optional ValueIfNull As String) As String

    'DECLARE VARIABLES
    Dim OpenTag As Integer
    Dim CloseTag As Integer
    Dim BreakTag As Integer
    Dim s As Variant
    Dim I As Integer

    'INITIAL SET
    On Error GoTo catchNotFound

    s = Split(ReadTextFile(TextFilePath), vbNewLine)

    For I = LBound(s, 1) To UBound(s, 1)

        'CHECK TO SEE IF KEY MATCHS LINES KEYVALUE
        OpenTag = InStr(s(I), """")
        CloseTag = InStr(OpenTag + 1, s(I), """")

        If Mid(s(I), OpenTag + 1, (CloseTag - OpenTag) - 1) = Key Then

            'GET THE KEYS NAME\VALUE PAIR
            BreakTag = InStr(s(I), ":")
            OpenTag = InStr(BreakTag, s(I), """")
            CloseTag = InStr(OpenTag + 1, s(I), """")

            KeyValueRead = Mid(s(I), OpenTag + 1, (CloseTag - OpenTag) - 1)
            Exit For

        End If

    Next I

    If KeyValueRead = "" Then
        KeyValueRead = ValueIfNull
    End If

catchNotFound:

End Function


'====================================================================
' Write TO File using KEY:VALUE method
'====================================================================
Public Function KeyValueWrite(TextFilePath As String, Key As String, Value As String) As Boolean

    'DECLARE VARIABLES
    Dim OpenTag As Integer
    Dim CloseTag As Integer
    Dim BreakTag As Integer

    Dim s As String
    Dim Arr As Variant
    Dim I As Long
    Dim Found As Boolean

    'INITIAL SET
    If FileExists(TextFilePath) = False Then
        If CreateFolderPath(TextFilePath) = False Then
            Exit Function
        End If
    End If

    Arr = Split(ReadTextFile(TextFilePath), vbNewLine)


    For I = LBound(Arr, 1) To UBound(Arr, 1)

        If Trim(Arr(I)) = "" Then GoTo nxt

        'CHECK TO SEE IF KEY MATCHS LINES KEYVALUE
        s = Arr(I)
        OpenTag = InStr(s, """")
        CloseTag = InStr(OpenTag + 1, s, """")

        'UPDATE VALUE IF IT IS FOUND
        If Mid(s, OpenTag + 1, (CloseTag - OpenTag) - 1) = Key Then

            s = """" & Key & """" & ":" & """" & Value & """"
            Arr(I) = s
            Found = True

        End If
nxt:
    Next I

    'IF IT WAS NOT FOUND, ADD RECORD TO THE END OF THE ARRAY
    If Found = False Then
        ReDim Preserve Arr(UBound(Arr, 1) + 1)
        Arr(UBound(Arr, 1)) = """" & Key & """" & ":" & """" & Value & """"
    End If

    'REWRITE ARRAY TO TEXTFILE
    WriteToTextFile TextFilePath, Join(Arr, vbNewLine)

End Function



'================================================
' READS TEXT FILE INTO A STRING, USING FILE PATH.
' PRIMARILY USED FOR SQL CONNECTIONS MODULE.
'================================================
Public Function ReadTextFile(filename As String) As String

    On Error Resume Next
    Set pTS = OpenTextFile(filename, ForReading, True)
    ReadTextFile = pTS.ReadAll
    Set pTS = Nothing

End Function

'================================================
' WRITES TEXT FILE INTO A STRING, USING FILE PATH.
' PRIMARILY USED FOR SQL CONNECTIONS MODULE.
'================================================
Public Function WriteToTextFile(filename As String, Text As String) As Boolean

    Set pTS = OpenTextFile(filename, 2, True)
    pTS.write (Text)
    Set pTS = Nothing
    WriteToTextFile = True

End Function

'=====================================================
' CREATES A FILE PATH - IF TEXT FILE WILL CREATE FILE
'=====================================================
Public Function CreateFolderPath(FullPath As String) As Boolean

    Dim fso As New cFileSystemObject
    Dim I As Integer
    Dim sPath() As String
    Dim CurPath As String

    On Error GoTo Catch
    sPath = Split(FullPath, "\")

    For I = LBound(sPath, 1) To UBound(sPath, 1) - 1
        CurPath = CurPath & sPath(I) & "\"
        If Not FolderExists(CurPath) Then
            Debug.Print "Created folder path:" & sPath(I)
            CreateFolder CurPath
        End If
    Next I

    CreateFolderPath = True
    Exit Function

Catch:
    CreateFolderPath = False

End Function

'=====================================================
' RETURNS TEMP FOLDER LOCATION
'=====================================================
Public Function TempFolder() As String

    TempFolder = Environ("TEMP")

End Function


'BUILT IN FUNCTIONS
Public Function OpenTextFile(filename As String, Optional IOMode As IOMode = ForReading, Optional Create As Boolean = True) As Object

    Set OpenTextFile = pFSO.OpenTextFile(filename, IOMode, Create)

End Function
Public Function CreateTextFile(filename As String, Optional Overwrite As Boolean = True) As Object

    Set CreateTextFile = pFSO.CreateTextFile(filename, Overwrite)

End Function
Public Function FileExists(FileSpec As String) As Boolean

    FileExists = pFSO.FileExists(FileSpec)

End Function
Public Function FolderExists(FileSpec As String) As Boolean

    FolderExists = pFSO.FolderExists(FileSpec)

End Function
Public Function CreateFolder(foldername As String) As String

    CreateFolder = pFSO.CreateFolder(foldername)

End Function
Public Function GetFolder(FolderPath As String) As Object

    Set GetFolder = pFSO.GetFolder(FolderPath)

End Function
Public Function GetFile(FilePath As String) As Object

    Set GetFolder = pFSO.GetFile(FilePath)

End Function
Public Function GetDrive(DriveSpec As String) As Object

    Set GetDrive = pFSO.GetDrive(DriveSpec)

End Function
Public Function GetDriveName(Path As String) As String

    GetDriveName = pFSO.GetDriveName(Path)

End Function
Public Function GetExtensionName(Path As String) As String

    GetExtensionName = pFSO.GetExtensionName(Path)

End Function
Public Function GetBaseName(Path As String) As String

    GetBaseName = pFSO.GetBaseName(Path)

End Function
Public Function GetAbsolutePathName(Path As String) As String

    GetAbsolutePathName = pFSO.GetAbsolutePathName(Path)

End Function
Public Function GetFileVersion(filename As String) As String

    GetFileVersion = pFSO.GetFileVersion(filename)

End Function
Public Function GetParentFolderName(Path As String) As String

    GetParentFolderName = pFSO.GetParentFolderName(Path)

End Function

Public Function DriveExists(DrivSpec As String) As Boolean

    DriveExists = pFSO.DriveExists(DrivSpec)

End Function
Public Function BuildPath(Path As String, Name As String) As String

    BuildPath = pFSO.BuildPath(Path, Name)

End Function

'METHODS
Public Sub DeleteFile(FileSpec As String, Optional Force As Boolean = False)

    pFSO.DeleteFile FileSpec, Force

End Sub
Public Sub DeleteFolder(FolderSpec As String, Optional Force As Boolean = False)

    pFSO.DeleteFile FolderSpec, Force

End Sub
Public Sub MoveFile(Source As String, Destination As String)

    pFSO.MoveFile Source, Destination

End Sub
Public Sub MoveFolder(Source As String, Destination As String)

    pFSO.MoveFolder Source, Destination

End Sub
Public Sub CopyFolder(Source As String, Destination As String, Optional OverWriteFiles As Boolean = True)

    pFSO.CopyFolder Source, Destination, OverWriteFiles

End Sub
Public Sub CopyFile(Source As String, Destination As String, Optional OverWriteFiles As Boolean = True)

    pFSO.CopyFile Source, Destination, OverWriteFiles

End Sub

在多个工作簿中更新VBA

2 个答案: