admin管理员组

文章数量:1124021

Working on a test file that:

  1. Auto-Saves the Workbook every 1 minute
  2. Userform pops up and shows the progress when macro runs.
  3. Status bar also shows progress (still deciding which option I like best: userform pop up or status bar)

Issue

  1. Userform pops up, but I get Run-time error '-2147418105 automation error the callee (server[not server application]) is not available and disappeared; all connections are invalid. The call may have executed.
  2. Userform will not execute until the status bar execution is completed.

Workbook Module

Option Explicit
'
'Following two code blocks + modAutoSave, autosaves the workbook every x seconds
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next
    Application.OnTime saveTimer, "Save1", , False
    Application.OnTime saveTimer, "Save2", , False 'Not sure if I need this?
End Sub
Private Sub Workbook_Open()
    saveTimer = Now + TimeValue("00:01:00")
    Application.OnTime saveTimer, "Save1"
    Application.OnTime saveTimer, "Save2" 'Not sure if I need this?
End Sub

Userform Module

Option Explicit
Public Sub UserForm_Activate()
    Dim i As Long
    For i = 1 To 1000
        With Me
            .Label1.Caption = "Saving file..." & Format(i / 1000, "Percent")
            .Show 'runtime error '-2147418105 automation error
            .Show (False) 'needed to set Modal to False or form doesn't pop up
            .Repaint 'shows image and label on userform, otherwise userform is blank
        End With
        saveTimer = Timer 
        Do 
        Loop While Timer - saveTimer < 0 
        DoEvents 'passes control to the operating system
        If i = 1000 Then Unload Me
    Next
End Sub

Regular Module

Sub Save1()

    Dim fName As String 'workbook filename
    
    Dim s As ufmAutoSave
    Set s = New ufmAutoSave

    fName = ThisWorkbook.Name & ".xlsm"

    If ThisWorkbook.Name = fName Then
        ThisWorkbook.Save
        Call StatusBar
        s.UserForm_Activate

    Else
        Call Save2
    End If
   
    saveTimer = Now + TimeValue("00:01:00")

    Application.OnTime saveTimer, "Save1"
    Sheets("Sheet1").[A1] = "Last saved: " & Format(Now, "mm-dd-yyyy hh:mm:ss AM/PM")

End Sub

Sub Save2()

    Dim pathB As String 'path of Backup file
    Dim bName As String 'workbook backup filename
    Dim myDate As Long 'date backup workbook was last modified, must be As Long to avoid result 12/31/1899

    Dim s As ufmAutoSave
    Set s = New ufmAutoSave

    pathB = "C:\Users\lritter\OneDrive - Carlisle Fluid Technologies\Desktop\Backup\"

    bName = pathB & "myBackup.xlsm"

    ThisWorkbook.SaveCopyAs Filename:=bName
    ThisWorkbook.Save
    Call StatusBar
    s.UserForm_Activate
    
    Application.OnTime saveTimer, "Save2"
   
    myDate = LastModified
    
    Sheets("Sheet1").[A2] = "Last backup: " & myDate & Format(Now, " mm-dd-yyyy hh:mm:ss AM/PM") 
    Sheets("Sheet1").[A3] = "Backup path: " & bName
    
End Sub

Function LastModified() As Date
    LastModified = vbNull 'puts a "1" in front of the date & time result in cell A2?
    'For example: "Last backup: 1 01-09-2025 03:38:35 PM"
    
    If Len(Trim$(pathB)) = 0 Then Exit Function
    
    With CreateObject("Scripting.FileSystemObject")
        If .FileExists(pathB) Then LastModified = .GetFile(pathB).DateLastModified
    End With
End Function

Sub StatusBar()
    Dim i As Integer
        For i = 1 To 1000
        saveTimer = Timer
        Do
        Loop While Timer - saveTimer < 0
        Application.StatusBar = "Saving file..." & Format(i / 1000, "Percent")
        DoEvents 'passes control to the operating system
    Next i
    Application.StatusBar = False
End Sub

I am still very new to VBA, so I appreciate your help.

In the Userform module, I tried changing "With Me" and "Unload Me" to "With ufmAutoSave" and "Unload ufmAutoSave", per a recommendation I found online. However, if I use the form name, the form doesn't appear at all. So, Me = error, ufmAutoSave = userform doesn't show.

本文标签: Userform Runtime Automation Error 2147418105 (servernot server applicationStack Overflow