I know that this works
[vba]
Sub Workbook_Open()
Applicativbacode] Is there a way to modify this to have it run on the last Friday of each month at the specified time? I have also found that using the 'MoveFiles macro it does what it is designed for but after the new file is opened it sits there even when changing the time. It doesn't realize that it is a new file instead it is looking at it like it has been open for a while. Is there a way to stop this? What the macro is designed to is move the copy of excel from one location to another and pull up an empty document? I have attached what I am working with
Here is the movefile macro that is also being used
[vba]
Option Explicit
Sub MoveFiles()
Workbooks("InspectorChecks.xls").Close savechanges:=True
Dim objFSO As FileSystemObject, objFolder As Folder, PathExists As Boolean
Dim objFile As File, strSourceFolder As String, strDestFolder As String
Dim x, Counter As Integer, Overwrite As String
Dim CName As String
ThisDate = Format(Date, "mm-dd-yy")
ThisTime = Format(Time, "hh-mm-ss")
CName = fOSMachineName
Application.ScreenUpdating = False 'turn screenupdating off
Application.EnableEvents = False 'turn events off
strSourceFolder = "C:\Documents and Settings\geyerb\Desktop\Inspect\" 'Source path
strDestFolder = "P:\InspectorChecks\" 'destination path, does not have to exist prior to execution
On Error Resume Next
x = GetAttr(strDestFolder) And 0
On Error GoTo errhandler
Set objFSO = New FileSystemObject 'creates a new File System Object reference
Set objFolder = objFSO.GetFolder(strSourceFolder) 'get the folder
Counter = 0 'set the counter at zero for counting files copied
If Not objFolder.Files.count > 0 Then GoTo NoFiles 'if no files exist in source folder "Go To" the NoFiles section
For Each objFile In objFolder.Files 'for every file in the folder...
objFile.Move strDestFolder & "\" & " " & CName & " " & ThisDate & " " & ThisTime & ".xls "
'objFile.Copy strDestFolder & "\" & objFile.Name 'Syntax for Copying file only, remove the ' to use
Counter = Counter + 1 'increment a count of files copied
'End If 'where conditional check, if applicable would be placed.
' Uncomment the If...End If Conditional as needed
Next objFile 'go to the next file
'' MsgBox "All " & Counter & " Files from " & vbCrLf & vbCrLf & strSourceFolder & vbNewLine & vbNewLine & _
'' " copied/moved to: " & vbCrLf & vbCrLf & strDestFolder, , "Completed Transfer/Copy!"
'Message to user confirming completion
Set objFile = Nothing: Set objFSO = Nothing: Set objFolder = Nothing 'clear the objects
Sleep 3000
Copys
Exit Sub
NoFiles:
'Message to alert if Source folder has no files in it to copy
MsgBox "There Are no files or documents in : " & vbNewLine & vbNewLine & _
strSourceFolder & vbNewLine & vbNewLine & "Please verify the path!", , "Alert: No Files Found!"
Set objFile = Nothing: Set objFSO = Nothing: Set objFolder = Nothing 'clear the objects
Application.ScreenUpdating = True 'turn screenupdating back on
Application.EnableEvents = True 'turn events back on
Exit Sub
errhandler:
'A general error message
MsgBox "Error: " & Err.Number & Err.Description & vbCrLf & vbCrLf & vbCrLf & _
"Please verify that all files in the folder are not currently open," & _
"and the source directory is available"
Err.Clear 'clear the error
Set objFile = Nothing: Set objFSO = Nothing: Set objFolder = Nothing 'clear the objects
Application.ScreenUpdating = True 'turn screenupdating back on
Application.EnableEvents = True 'turn events back on
End Sub
Sub Copys()
FileCopy "P:\InspectorChecks\masters\InspectorChecks.xls", "C:\Documents and Settings\geyerb\Desktop\Inspect\InspectorChecks.xls"
Application.EnableEvents = True
Workbooks.Open FileName:="C:\Documents and Settings\geyerb\Desktop\Inspect\InspectorChecks.xls"
End Sub
[/vba]
Reply With Quote
