我已经写了一个宏来打开所有的xlsx文件从一个提供的文件夹路径，改变一个特定的工作表的单元格值，并将其保存为一个新的文件在一个不同的提供的文件夹路径。
宏做我想做的。
我在连接到Jedox服务器的文件上运行此宏。
在这段代码运行之后，我运行宏的原始工作簿崩溃了。

Function GetUNCLateBound(ByVal strMappedDrive As String) As String

    Dim objFso As Object
    Set objFso = CreateObject("Scripting.FileSystemObject")

    Dim strDrive As String
    Dim strShare As String

    'Separate the mapped letter from any following sub-folders
    strDrive = objFso.GetDriveName(strMappedDrive)

    'Find the UNC share name from the mapped letter
    strShare = objFso.Drives(strDrive & "\").ShareName

    'The Replace function allows for sub-folders of the mapped drive
    GetUNCLateBound = Replace(strMappedDrive, strDrive, strShare)

    Set objFso = Nothing 'Destroy the object

End Function

Sub UpdateConnection()
    Dim wb As Workbook
    Dim wbNew As Workbook
    Dim vDevConName As Range
    Dim vProdConName As Range
    Dim vProdFolder As Range
    Dim vDevFolder As Range
    Dim vWBFromPath As String
    Dim vWBToPath As String

    ' Macro Optimization Settings
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Set wb = ThisWorkbook

    Set vDevConName = wb.Names("rngDevConnection").RefersToRange
    Set vProdConName = wb.Names("rngProdConnection").RefersToRange
    Set vDevFolder = wb.Names("rngDevFolder").RefersToRange
    Set vProdFolder = wb.Names("rngProdFolder").RefersToRange

    vWBToPath = GetUNCLateBound(wb.Path) & "\" & vProdFolder & "\"
    If Dir(vWBToPath, vbDirectory) = "" Then
        MkDir vWBToPath
    End If

    Dim myPath As String
    Dim myFile As String
    Dim myExtension As String

    'Retrieve Target Folder Path
    vWBFromPath = GetUNCLateBound(wb.Path) & "\" & vDevFolder & "\"

    'In Case of Cancel
    myPath = vWBFromPath
    If myPath = "" Then GoTo ResetSettings

    'Target File Extension (must include wildcard "*")
    myExtension = "*.xls*"

    'Loop through each Excel file in folder
    myFile = Dir(myPath & myExtension)
    Do While myFile <> ""
        'Set variable equal to opened workbook
        Set wbNew = Workbooks.Open(Filename:=myPath & myFile)

        'Ensure Workbook has opened before moving on to next line of code
        DoEvents

        'Change cell B2 to provided PROD connection name
        With wbNew.Sheets("Params").Range("B2")
            .Value = vProdConName.Value
            .Calculate
            .Calculate
        End With

        'Suppresses warning about overwriting files
        Application.DisplayAlerts = False

        wbNew.SaveAs Filename:=vWBToPath & myFile, FileFormat:=51
        wbNew.Close SaveChanges:=True

        Application.DisplayAlerts = True
        'Ensure Workbook has closed before moving on to next line of code
        DoEvents

        'Get next file name
        myFile = Dir
    Loop

    'Activate the original workbook
    wb.Activate

    'Message Box when tasks are completed
    MsgBox "Task Complete!"

ResetSettings:
    'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub