Error 1004 Randomly

A

agentkramr

Board Regular
Joined
Dec 27, 2021
Messages
98
Platform
  1. Windows
I have a macro that gets launched by a vbs script that i have going so the macro is

VBA Code: 
Sub CB_Hourly()

Dim oApp As Object, oMail As Object, FileStr As String

Dim NewWb As Workbook, cnt As Integer

Dim FileName As String, MailSub As String, MailTxt As String

Dim tmpImageName As String

'************************************************* ********

'Set email details; Comment out if not required

Const MailTo = "test@test.com"

'Const MailCC = "[EMAIL]some2@someone.com[/EMAIL]"

'Const MailBCC = "[EMAIL]some3@someone.com[/EMAIL]"

MailSub = "Test"

MailTxt = ""



Workbooks("Test Hourly Counts Auto").RefreshAll



'Turns off screen updating

Application.ScreenUpdating = False

Sheets("1 Hour Counts").Unprotect "Test"

'define a temp path for your image

tmpImageName = Environ$("temp") & "" & "TempChart.jpg"

'create image file

Call CreateJpg("1 Hour Counts", Sheets("1 Hour Counts").Range("A1:T50"))

'copy range to new wb/remove formulas

Set NewWb = Workbooks.Add

'copy all sheets

For cnt = 1 To ThisWorkbook.Sheets.Count

ThisWorkbook.Sheets(cnt).Copy NewWb.Sheets(cnt)

Next cnt

NewWb.Sheets("1 Hour Counts").Range("A1:T50").Copy

NewWb.Worksheets("1 Hour Counts").Range("A1").PasteSpecial Paste:=xlPasteValues

Application.CutCopyMode = False

'NewWb.Worksheets("1 Hour Counts").Shapes("Rectangle: Rounded Corners 1").Delete

'NewWb.Worksheets("1 Hour Counts").Shapes("Rectangle: Rounded Corners 2").Delete

NewWb.Worksheets("1 Hour Counts").Activate

NewWb.Worksheets("1 Hour Counts").Range("A1").Select

Application.DisplayAlerts = False

NewWb.Worksheets("Sheet1").Delete

NewWb.SaveAs FileName:=Left(ThisWorkbook.FullName, Len(ThisWorkbook.FullName) - 5) & ".xlsx", _

FileFormat:=xlOpenXMLWorkbook

Application.DisplayAlerts = True

FileStr = NewWb.FullName

NewWb.Close

Sheets("1 Hour Counts").Protect "Test"



'Creates and shows the outlook mail item



Set oApp = CreateObject("Outlook.Application")



Set oMail = oApp.CreateItem(0)



With oMail



.To = MailTo



'.Cc = MailCC



'.Bcc = MailBCC



.Subject = MailSub



.HTMLBody = "<body><img src=" & "'" & tmpImageName & "'/></body>"



.Attachments.Add FileStr



.Display



.Send



End With



'Deletes the temporary file



'WB.ChangeFileAccess Mode:=xlReadOnly



Kill (Environ$("temp") & "" & "TempChart.jpg")



Kill FileStr





'Restores screen updating and release Outlook



Application.ScreenUpdating = True



Set oMail = Nothing



Set oApp = Nothing



'Save Workbook



'ThisWorkbook.Save



End Sub



Public Sub CreateJpg(SheetName As String, xRgAddrss As Range)

'creates temp JPG file of range (xRgAddrss) by creating temp chart

'uses current wb sheet (sheetname) to locate temp chart

Dim xRgPic As Range

Worksheets(SheetName).Activate

Set xRgPic = xRgAddrss

xRgPic.CopyPicture Appearance:=xlScreen, Format:=xlPicture

With ThisWorkbook.Worksheets(SheetName).ChartObjects.Add(xRgPic.Left, xRgPic.Top, _

xRgPic.Width, xRgPic.Height)

.Activate

.Chart.Paste

.Chart.Export Environ$("temp") & "" & "TempChart.jpg", "JPG"

End With

Worksheets(SheetName).ChartObjects(Worksheets(SheetName).ChartObjects.Count).Delete

End Sub

i keep getting a random "error 1004" on line
VBA Code: 
xRgPic.CopyPicture Appearance:=xlScreen, Format:=xlPicture

it happens intermittently , it will work fine once or twice then do it again ...

the vbs i have just opens the workbook runs this macro and then closes the workbook

Code: 
dim EXL
Set EXL = CreateObject("Excel.Application")
'not required
EXL.Visible = true

'File and Macro Call
EXL.Workbooks.open "C:\Users\automatedreports\Desktop\Automated Reports\Hourly\CB Hourly Counts Auto"
EXL.Run "CB_Hourly"

'Close Application
EXL.Quit
Set EXL  = Nothing

which i am also trying to figure out how to add save the workbook to

Any help is greatly appreciated , i have been trying to wrap up this project for weeks but the random error is killing me
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Sort by date Sort by votes
I think i already tried to help you in the past.
You have to brake the execution of the program, but apparently my explanation wasn't good :unsure:

a new trial
The macro "Wait_A_Moment(msec)" waits x milliseconds before going on.
You can test it with the macro "test", the msgbox gives you 2 values with approx. 0.500 difference = 0.5 secondes difference

Add a delay of 500 millisecondes just before and just after your critical "CopyPicture" and play a little bit with those 500 (start with 1000 and decrement).
I'm not sure, but the 1st "Wait" isn't necessary, so you can delete him afterwards.

VBA Code: 
Sub test()
     t = Timer
     Wait_A_Moment 500                                          'hold for 500 msec
     MsgBox t & vbLf & Timer
End Sub

Sub YourMacro()
     ...
     Wait_A_Moment 500                                          'hold for 500 msec
     xRgPic.CopyPicture Appearance:=xlScreen, Format:=xlPicture
     Wait_A_Moment 500                                          'hold for 500 msec
     ...
End Sub

Sub Wait_A_Moment(msec)
     '******************************************************
     'this macro holds the further execution of your program for x milliseconds
     '******************************************************
     d = Date                                                   'actual date
     t = Timer + msec / 1000                                    'actual timer + x milliseconds
     Do                                                         'start loop
          DoEvents
     Loop While (Timer - 86400 * (d <> Date)) < t               'until timer is x milliseconds later
End Sub
 
Upvote 0
Solution
BSALV said:
I think i already tried to help you in the past.
You have to brake the execution of the program, but apparently my explanation wasn't good :unsure:

a new trial
The macro "Wait_A_Moment(msec)" waits x milliseconds before going on.
You can test it with the macro "test", the msgbox gives you 2 values with approx. 0.500 difference = 0.5 secondes difference

Add a delay of 500 millisecondes just before and just after your critical "CopyPicture" and play a little bit with those 500 (start with 1000 and decrement).
I'm not sure, but the 1st "Wait" isn't necessary, so you can delete him afterwards.

VBA Code: 
Sub test()
     t = Timer
     Wait_A_Moment 500                                          'hold for 500 msec
     MsgBox t & vbLf & Timer
End Sub

Sub YourMacro()
     ...
     Wait_A_Moment 500                                          'hold for 500 msec
     xRgPic.CopyPicture Appearance:=xlScreen, Format:=xlPicture
     Wait_A_Moment 500                                          'hold for 500 msec
     ...
End Sub

Sub Wait_A_Moment(msec)
     '******************************************************
     'this macro holds the further execution of your program for x milliseconds
     '******************************************************
     d = Date                                                   'actual date
     t = Timer + msec / 1000                                    'actual timer + x milliseconds
     Do                                                         'start loop
          DoEvents
     Loop While (Timer - 86400 * (d <> Date)) < t               'until timer is x milliseconds later
End Sub
Click to expand...
you have helped me in the past and i greatly appreciate it, this works thank you so much , i also found that if i create a vbs for each file that i was trying to make this work with instead of them firing off in the same vbs one after the other that seems to have fixed the issue as well. I appreciate all the help you have given me !
 
Upvote 0
Working in a batch gives you the problem with random errors, it works twice, 3 times and then an error etc.
Working one by one is okay.
So you had to find out, method trial and error, where to brake your macro just a little bit, to pass without error.

You're welcome.
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
VBA to Email Workbook
Replies
1
Views
824
agentkramr
A
A
  • Solved
VBA to send workbook but take a screen shot of a section of the newest sheet and attach in body of email
Replies
2
Views
1K
agentkramr
A
A
  • Question Question
add to VBA to wait for background queries to finish before starting
Replies
7
Views
2K
BSALV
BSALV
A
  • Question Question
VBA screenshots sheet section to paste in to the body of an email , copies the workbook and attaches it to an email, then emails
Replies
6
Views
3K
NdNoviceHlp
NdNoviceHlp
A
  • Question Question
VBA Question
2 3
Replies
23
Views
2K
agentkramr
A

Forum statistics

Threads
1,223,887
Messages
6,175,199
Members
452,617
Latest member
Narendra Babu D

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top