Results 1 to 2 of 2

Need help with auto close code

Threaded View

  1. #1
    Registered User
    Join Date
    09-18-2012
    Location
    US
    MS-Off Ver
    Excel 2007
    Posts
    1

    Need help with auto close code

    I've been working on this problem for days, I've run out of ideas. Here's the situation. I have several daily workbooks, each is for a resident in the pod I work on. Then there is a pod report workbook. The pod report workbook opens each of the daily workbooks, copies some data over then closes the workbook. The problem that I am running into is that all of the daily workbooks are opening back up after being closed by the pod report workbook.

    Each of the daily workbooks has this in a standard module.

    Dim DownTime As Date
    
    Sub SetTime()
    DownTime = Now + TimeValue("00:15:00")
    Application.OnTime DownTime, "ShutDown"
    End Sub
    
    Sub ShutDown()
    ThisWorkbook.save
    Application.Quit
    End Sub
    
    Sub Disable()
    On Error Resume Next
    Application.OnTime EarliestTime:=DownTime, Procedure:="ShutDown", _
    Schedule:=False
    End Sub
    This code is in thisworkbook module

    Private Sub Workbook_Open()
    Application.ScreenUpdating = False
    ThisWorkbook.ActiveSheet.Cells(6, 4).Select
    Application.ScreenUpdating = True
    Call SetTime
    End Sub
    
    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim rName As String, sName As String, pName As String
    rName = Sheets("Template").Range("C3").Value
    sName = rName & " " & Format(Now, "mm - dd - yyyy (hh mm ss)")
    pName = rName & "\" & "Daily"
        If ThisWorkbook.Sheets("Template").Range("C3").Value <> "" And Len(Dir("O:\JuvenileCenter\PC Backup\ULA\" & rName & "\" & "Daily", vbDirectory)) = 0 Then
        ChDir "O:\JuvenileCenter\PC Backup\ULA"
        ChDir rName
        MkDir "Daily"
        ChDir "Daily"
        ThisWorkbook.SaveAs Filename:=sName & ".xlsm"
        Call Disable
        ElseIf ThisWorkbook.Sheets("Template").Range("C3").Value <> "" And Len(Dir("O:\JuvenileCenter\PC Backup\ULA\" & rName & "\" & "Daily", vbDirectory)) <> 0 Then
        ChDir "O:\JuvenileCenter\PC Backup\ULA"
        ChDir rName
        ChDir "Daily"
        ThisWorkbook.SaveAs Filename:=sName & ".xlsm"
        Call Disable
        Exit Sub
        End If
        Call Disable
    End Sub
    
    Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    Call Disable
    Call SetTime
    End Sub
    
    Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target _
    As Excel.Range)
    Call Disable
    Call SetTime
    End Sub
    I need some help on this one I can't figure it out. Thanks guys.
    Attached Files Attached Files

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1