Hello Forum!
I'm having a problem with the following macro I have written (see below). I've written it to where it runs at 7:35 AM (I should note I cannot use Windows Scheduler due to lack of administrative rights on my work PC) and was having problems with it running multiple times and sending multiple emails, so I added the Application.Wait command to ensure that it wouldn't do that. The problem is it still runs at 7:35 and now at 7:38! Any help would be appreciated as I am a basic VBA coder and have no idea how to fix this issue.
Thanks in advance!![]()
Dim TimeToRun Sub auto_open() Call ScheduleCopyPriceOver End Sub Sub ScheduleCopyPriceOver() TimeToRun = Now + TimeValue("00:00:01") Application.OnTime TimeToRun, "ScheduleCopyPriceOver" If Time = TimeSerial(7, 35, 0) Then Application.OnTime TimeToRun, "CopyPriceOver" End If End Sub Sub CopyPriceOver() Dim txtfilename As String Dim currentWb As Workbook Dim openWb As Workbook Dim newWb As Workbook Dim openWs As Worksheet Dim currentWs As Worksheet Dim OutApp As Object Dim OutMail As Object Dim TempFilePath As String Dim TempFileName As String Dim FileExtStr As String txtfilename = "\\path\" & "report" & "*" Set currentWb = ThisWorkbook Set openWb = Workbooks.Open(txtfilename) openWb.Sheets("Tabelle1").Activate ActiveSheet.Columns("A:F").Select Selection.Copy currentWb.Sheets("Tabelle1").Activate ActiveSheet.Cells(1, 1).Activate ActiveSheet.Paste Calculate currentWb.Save openWb.Close Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) With OutMail .To = "bossman" ' .CC = "" .BCC = "" .Subject = "Update " & Now .attachments.Add currentWb.FullName .send End With Set OutMail = Nothing Set OutApp = Nothing Application.Wait Now + TimeValue("00:03:00") Call ScheduleCopyPriceOver End Sub Sub auto_close() On Error Resume Next Application.OnTime TimeToRun, "ScheduleCopyPriceOver", , False ActiveWorkbook.Close End Sub











LinkBack URL
About LinkBacks
Register To Reply

Bookmarks