Hi all,
For the past few weeks i have been using a code for my system and it has been working perfectly fine.
Recently i started getting error 53 and i have made no changes to the code.
Could someone tell me why?
(sorry for the messy code! I am still learning VBA)
Sub TransferDataEmail()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
'Dim ws3 As Worksheet
'Dim wkb1 As Workbook
'Dim SourceRng As Range, DestCell As Range
Set ws1 = Worksheets("Sheet3")
Set ws2 = Worksheets("TransferToRegister")
Dim LastRow As Long
ws1.Activate
'ws2.Unprotect "1985"
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range(Cells(LastRow, 1), Cells(LastRow, 11)).Copy
ws2.Range("A2:J2").PasteSpecial xlPasteValues
Range("A1").Select
Application.CutCopyMode = False
'-----------------------the email code starts here---------------------------------------------------------
Dim olApp As outlook.Application 'You set the reference to use Outlook via Tools Menu and References
Dim olMail As MailItem
Set olApp = New outlook.Application
Set olMail = olApp.CreateItem(olMailItem)
Dim activereport As String
activereport = ActiveWorkbook.Name
Dim oApp, oMail As Object, _
tWB, cWB As Workbook, _
FileName, FilePath As String
'Save active workbook to temporary file
Set cWB = ActiveWorkbook
Sheets("TransferToRegister").Copy ' If you only wish to send the active sheet then uncomment this line
Set tWB = ActiveWorkbook
FileName = "Copy of " & activereport 'You can define the name
FilePath = Environ("TEMP")
On Error Resume Next
Kill FilePath & "\" & FileName
On Error GoTo 0
Application.DisplayAlerts = False
tWB.SaveAs FileName:=FilePath & "\" & FileName, FileFormat:=52
Application.DisplayAlerts = True
'Sending email through outlook
ActiveSheet.Unprotect
With olMail
.To = Worksheets("TransferToRegister").Range("U1").Value
.Subject = "OFI For " & Worksheets("TransferToRegister").Range("M1").Value
.Body = "Please attach any pictures/reference with this OFI"
.Attachments.Add ActiveWorkbook.FullName
.Display
End With
Set olMail = Nothing
Set olApp = Nothing
'Delete the temporary file and restore screen updating
tWB.ChangeFileAccess Mode:=xlReadOnly
Kill tWB.FullName
tWB.Close SaveChanges:=False
cWB.Activate
Application.ScreenUpdating = True
Set oMail = Nothing
Set oApp = Nothing
'------the transfer to trevors workbook code starts here----------------------------------------------------------------------
Dim wbk1 As Workbook
Dim wbk4 As Workbook
Dim pasteSheet As Worksheet
Dim copySheet As Worksheet
Set wkb1 = ThisWorkbook
Set wkb4 = Workbooks.Open("T:\ROC-IT PROGAM\OFI Management\OFIBridgeSheet.xlsm", UpdateLinks:=0)
Application.AskToUpdateLinks = False
Set pasteSheet = wkb4.Sheets("Sheet1")
Set copySheet = wkb1.Sheets("TransferToRegister")
copySheet.Unprotect
copySheet.Range("A2:J2").Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
wkb4.Close True
Application.ScreenUpdating = True
Worksheets("Sheet2").Activate
ThisWorkbook.Save
ThisWorkbook.Close SaveChanges:=True
End Sub
For the past few weeks i have been using a code for my system and it has been working perfectly fine.
Recently i started getting error 53 and i have made no changes to the code.
Could someone tell me why?
(sorry for the messy code! I am still learning VBA)
Sub TransferDataEmail()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
'Dim ws3 As Worksheet
'Dim wkb1 As Workbook
'Dim SourceRng As Range, DestCell As Range
Set ws1 = Worksheets("Sheet3")
Set ws2 = Worksheets("TransferToRegister")
Dim LastRow As Long
ws1.Activate
'ws2.Unprotect "1985"
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range(Cells(LastRow, 1), Cells(LastRow, 11)).Copy
ws2.Range("A2:J2").PasteSpecial xlPasteValues
Range("A1").Select
Application.CutCopyMode = False
'-----------------------the email code starts here---------------------------------------------------------
Dim olApp As outlook.Application 'You set the reference to use Outlook via Tools Menu and References
Dim olMail As MailItem
Set olApp = New outlook.Application
Set olMail = olApp.CreateItem(olMailItem)
Dim activereport As String
activereport = ActiveWorkbook.Name
Dim oApp, oMail As Object, _
tWB, cWB As Workbook, _
FileName, FilePath As String
'Save active workbook to temporary file
Set cWB = ActiveWorkbook
Sheets("TransferToRegister").Copy ' If you only wish to send the active sheet then uncomment this line
Set tWB = ActiveWorkbook
FileName = "Copy of " & activereport 'You can define the name
FilePath = Environ("TEMP")
On Error Resume Next
Kill FilePath & "\" & FileName
On Error GoTo 0
Application.DisplayAlerts = False
tWB.SaveAs FileName:=FilePath & "\" & FileName, FileFormat:=52
Application.DisplayAlerts = True
'Sending email through outlook
ActiveSheet.Unprotect
With olMail
.To = Worksheets("TransferToRegister").Range("U1").Value
.Subject = "OFI For " & Worksheets("TransferToRegister").Range("M1").Value
.Body = "Please attach any pictures/reference with this OFI"
.Attachments.Add ActiveWorkbook.FullName
.Display
End With
Set olMail = Nothing
Set olApp = Nothing
'Delete the temporary file and restore screen updating
tWB.ChangeFileAccess Mode:=xlReadOnly
Kill tWB.FullName
tWB.Close SaveChanges:=False
cWB.Activate
Application.ScreenUpdating = True
Set oMail = Nothing
Set oApp = Nothing
'------the transfer to trevors workbook code starts here----------------------------------------------------------------------
Dim wbk1 As Workbook
Dim wbk4 As Workbook
Dim pasteSheet As Worksheet
Dim copySheet As Worksheet
Set wkb1 = ThisWorkbook
Set wkb4 = Workbooks.Open("T:\ROC-IT PROGAM\OFI Management\OFIBridgeSheet.xlsm", UpdateLinks:=0)
Application.AskToUpdateLinks = False
Set pasteSheet = wkb4.Sheets("Sheet1")
Set copySheet = wkb1.Sheets("TransferToRegister")
copySheet.Unprotect
copySheet.Range("A2:J2").Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
wkb4.Close True
Application.ScreenUpdating = True
Worksheets("Sheet2").Activate
ThisWorkbook.Save
ThisWorkbook.Close SaveChanges:=True
End Sub
