Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Private Const VK_SNAPSHOT As Byte = 44
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Const SW_SHOWMAXIMIZED = 3
Private Const VK_LCONTROL As Long = &HA2
Private Const VK_V = &H56
Private Const KEYEVENTF_KEYUP = &H2
Sub Copy_Web_Paste_Email()
Sheets("List").Select
' Copy Cell Above Empty
Dim iBook As Workbook
Dim iSheet As Worksheet
Set iBook = ThisWorkbook
Set iSheet = Sheets("List") ' run time error 9 subscript out of range
With iSheet
If IsEmpty(Range("D2").Offset(1, 0)) Then
Range("D2").Copy Range("D2").Offset(1, 0)
Else
Range("D2").End(xlDown).Copy Range("D2").End(xlDown).Offset(1, 0)
End If
End With
Dim iBook2 As Workbook
Dim iSheet2 As Worksheet
Set iBook2 = ThisWorkbook
Set iSheet2 = Sheets("List")
With iSheet2
If IsEmpty(Range("E2").Offset(1, 0)) Then
Range("E2").Copy Range("E2").Offset(1, 0)
Else
Range("E2").End(xlDown).Copy Range("E2").End(xlDown).Offset(1, 0)
End If
End With
'Removes formulas above the last line
Dim ALR As Long
Dim ALR2 As Range
With Sheets("List") ' Sheet name
ALR = .Range("D" & .Rows.Count).End(xlUp).Row ' Letter in " " is the row you want code to run
Set ALR2 = .Range("D2:E" & ALR - 1) ' " " is were you choose range "A" or "A:Z" for more the one row & ALR - 1) - 1 minus one
ALR2.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
Application.CutCopyMode = False
Dim myValue As Variant
myValue = InputBox("Enter Properly Formated Parcel#", "Please")
'Step 1: Declare Your Variables.
Dim LastRow As Long
'Step 2: Capture the last used row number.
LastRow = Cells(Rows.Count, 3).End(xlUp).Row ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
'Step 3: Select the next row down
Cells(LastRow, 3).Offset(1, 0).Value = myValue ' Select ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
Dim myValue2 As Variant
myValue2 = InputBox("Requesters Name. Don't Use & or '", "Please")
'Step 1: Declare Your Variables.
Dim LastRow2 As Long
'Step 2: Capture the last used row number.
LastRow2 = Cells(Rows.Count, 6).End(xlUp).Row ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
'Step 3: Select the next row down
Cells(LastRow2, 6).Offset(1, 0).Value = myValue2 ' Select ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
Dim myValue3 As Variant
myValue3 = MsgBox("Did you recive payment? If yes click YES else just hit enter.", vbQuestion + vbYesNo + vbDefaultButton2, "Do you have check in Hand?") ' InputBox("Enter Check# if Paid Else Hit Enter", "Please", "Unpaid")
'Step 1: Declare Your Variables.
Dim LastRow3 As Long
'Step 2: Capture the last used row number.
If myValue3 = vbYes Then
LastRow3 = Cells(Rows.Count, 2).End(xlUp).Row ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
'Step 3: Select the next row down
Cells(LastRow3, 2).Offset(1, 0).Value = "PAID" ' Select ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
'Cells(LastRow3, 1).Offset(1, 0).Value = "$30"
Else
LastRow3 = Cells(Rows.Count, 2).End(xlUp).Row ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
'Step 3: Select the next row down
Cells(LastRow3, 2).Offset(1, 0).Value = "UNPAID" ' Select ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
' Cells(LastRow3, 1).Offset(1, 0).Value = "$0"
End If
Dim myValue4 As Variant
myValue4 = InputBox("Enter Date If Not Todays Date for Sent Date. Format 00/00/00", "Please", Format(Now(), "mm/dd/yy"))
'Step 1: Declare Your Variables.
Dim LastRow4 As Long
'Step 2: Capture the last used row number.
LastRow4 = Cells(Rows.Count, 8).End(xlUp).Row ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
'Step 3: Select the next row down
' Cells(LastRow4, 8).Offset(1, 0).Select ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
Cells(LastRow4, 8).Offset(1, 0).Value = myValue4 ' Select ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
'Print to PDF
Sheets(Array("Tax Cert Bill", "Tax Cert Form 2022-2021")).Select
' ChDir "T:\2022_TAX_CERTS\"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="T:\2022_TAX_CERTS\" & Sheets("Tax Cert Bill").Range("B17").Value & " - " & Sheets("Tax Cert Bill").Range("B12").Value & Format(Date, " - mm-dd-yyyy"), _
OpenAfterPublish:=True, ignoreprintareas:=False
'
'
' IE and OutLook
'Declare Variables
Dim EmailApp As Object
Dim EmailItem As Object
Dim myAttachments As Object
Dim mailAddress As String
Dim TaxCertPDF As String
Dim NorryLink As String
Dim EMail As String
' Set Variables E-Mail
Set EmailApp = CreateObject("Outlook.application")
Set EmailItem = EmailApp.CreateItem(0)
Set myAttachments = EmailItem.Attachments
' Link to copy Print Screen
NorryLink = "Home - County of Northumberland" & Sheets("Tax Cert Bill").Range("B17").Value
' E-Mail Subject Parcel - Requestor - Date.pdf
TaxCertPDF = "T:\2022_TAX_CERTS\" & Sheets("Tax Cert Bill").Range("B17").Value & " - " & Sheets("Tax Cert Bill").Range("B12").Value & Format(Date, " - mm-dd-yyyy") & ".pdf"
' Look for the mail address in the MailInfo worksheet
' mailAddress = Application.WorksheetFunction.VLookup(Worksheets("Tax Cert Bill").Range("B12").Value, Worksheets("Requestors").Range("A:A") & Worksheets("Requestors").Rows.Count), 2, False)
'EMail =index(Sheets("Requestor")A:B,MATCH(Sheets("Tax Cert Bill").Range("B12").Value,Sheets("Requestor")A:A,0),2)
' mailAddress = Sheets("Tax Cert Bill").Range("B12").Value = WorksheetFunction.Match(Sheets("Tax C").Range("C5").Value, Sheets("Data").Range("D5:D10"), 0)
' mailAddress = INDEX('Requestor'!A:B,MATCH('Tax Cert Bill'!C12,'Requestor'!A:A,0),2)
' INDEX(A1:C10,2,3)
' Look for the mail address in the MailInfo worksheet
Dim FinalResult As Variant, Table_Range As Range, LookupValue As Range
Set Table_Range = Sheets("Requestor").Range("A:B")
Set LookupValue = Sheets("Tax Cert Bill").Range("B12")
FinalResult = Application.WorksheetFunction.VLookup(LookupValue, Table_Range, 2, False)
' IE Code For Copy Paste
Dim IE As Object
Dim hwnd As Long, IECaption As String
Set IE = CreateObject("InternetExplorer.Application")
' Do Until lHwnd <> 0
' Set IE Size
IE.Visible = True
IE.Width = 624
IE.Height = 756
IE.Navigate NorryLink
Sleep 5000
'~~> Get the caption of IE
IECaption = "Home - County of Northumberland"
'~~> Get handle of IE
hwnd = FindWindow(vbNullString, IECaption)
If hwnd = 0 Then
MsgBox "IE Window Not found!"
Exit Sub
Else
'~~> Maximize IE
' ShowWindow hwnd, SW_SHOWMAXIMIZED
IE.Width = 624
IE.Height = 756
End If
Sleep 3000
DoEvents
'~~> Take a snapshot
Call keybd_event(VK_SNAPSHOT, 1, 0, 0)
'~~> Start Word
' Set wordobj = CreateObject("Word.Application")
' Set objDoc = wordobj.Documents.Add
' wordobj.Visible = True
' EmailApp.Visible = True
' Set objSelection = wordobj.Selection
' Set objSelection = EmailApp.Selection
'Paste into Word
' objSelection.Paste
' Set objSelection = EmailApp.Selection
' void keybd_event(
' keybd_event VK_LCONTROL, 0, 0, 0, keybd_event VK_V, 0, 0, 0, keybd_event VK_V, 0, KEYEVENTF_KEYUP, 0, keybd_event VK_LCONTROL, 0, KEYEVENTF_KEYUP, 0);
'keybd_event VK_LCONTROL, 0, 0, 0 'PRESS CTL
'keybd_event VK_V, 0, 0, 0 'PRESS V
'keybd_event VK_V, 0, KEYEVENTF_KEYUP, 0 'RELEASE V
'keybd_event VK_LCONTROL, 0, KEYEVENTF_KEYUP, 0 'RELEASE CTL
Dim CObj As MSForms.DataObject
Set CObj = New MSForms.DataObject
CObj.GetFromClipboard
XText = CObj.GetText(1)
' ActiveSheet.Range("B4").Value = XText
'Specify Email Items and Add Attachment
With EmailItem
.To = EMail
.Subject = Sheets("Tax Cert Bill").Range("B17").Value
.body = XText
.Attachments.Add TaxCertPDF
'.send
.Display
End With
Set EmailItem = Nothing
Set EmailApp = Nothing
Sheets("List").Select
' MsgBox "PDF has been successfully Saved in T:\2022_TAX_CERTS\Parcel# - Requester - Todays Date.pdf"
'Step 1: Declare Your Variables.
Dim LastRow5 As Long
'Step 2: Capture the last used row number.
LastRow5 = Cells(Rows.Count, 3).End(xlUp).Row ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
'Step 3: Select the next row down
Cells(LastRow5, 3).Offset(1, 0).Select ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
' Range().Value = myValue
' Dim myValue As Variant
' myValue = InputBox("Enter Properly Formated Parcel#", "Please")
ActiveWorkbook.Save 'd = True
MsgBox "done"
End Sub
it has been since i put lines
' IE Code For Copy Paste
Dim IE As Object
Dim hwnd As Long, IECaption As String
Set IE = CreateObject("InternetExplorer.Application")
' Do Until lHwnd <> 0
' Set IE Size
IE.Visible = True
IE.Width = 624
IE.Height = 756
IE.Navigate NorryLink
Sleep 5000
'~~> Get the caption of IE
IECaption = "Home - County of Northumberland"
'~~> Get handle of IE
hwnd = FindWindow(vbNullString, IECaption)
If hwnd = 0 Then
MsgBox "IE Window Not found!"
Exit Sub
Else
'~~> Maximize IE
' ShowWindow hwnd, SW_SHOWMAXIMIZED
IE.Width = 624
IE.Height = 756
End If
Sleep 3000
DoEvents
'~~> Take a snapshot
Call keybd_event(VK_SNAPSHOT, 1, 0, 0)
'~~> Start Word
' Set wordobj = CreateObject("Word.Application")
' Set objDoc = wordobj.Documents.Add
' wordobj.Visible = True
' EmailApp.Visible = True
' Set objSelection = wordobj.Selection
' Set objSelection = EmailApp.Selection
'Paste into Word
' objSelection.Paste
' Set objSelection = EmailApp.Selection
' void keybd_event(
' keybd_event VK_LCONTROL, 0, 0, 0, keybd_event VK_V, 0, 0, 0, keybd_event VK_V, 0, KEYEVENTF_KEYUP, 0, keybd_event VK_LCONTROL, 0, KEYEVENTF_KEYUP, 0);
'keybd_event VK_LCONTROL, 0, 0, 0 'PRESS CTL
'keybd_event VK_V, 0, 0, 0 'PRESS V
'keybd_event VK_V, 0, KEYEVENTF_KEYUP, 0 'RELEASE V
'keybd_event VK_LCONTROL, 0, KEYEVENTF_KEYUP, 0 'RELEASE CTL
Dim CObj As MSForms.DataObject
Set CObj = New MSForms.DataObject
CObj.GetFromClipboard
XText = CObj.GetText(1)
' ActiveSheet.Range("B4").Value = XText
else it worked right except did not paste value from clipboard in e-mail body or load webpage to screen shot. I had it loading webpage and screenshot it. pasting to word so was trying to get it to post to email body.
any help would be greatfull thanks.
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Private Const VK_SNAPSHOT As Byte = 44
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Const SW_SHOWMAXIMIZED = 3
Private Const VK_LCONTROL As Long = &HA2
Private Const VK_V = &H56
Private Const KEYEVENTF_KEYUP = &H2
Sub Copy_Web_Paste_Email()
Sheets("List").Select
' Copy Cell Above Empty
Dim iBook As Workbook
Dim iSheet As Worksheet
Set iBook = ThisWorkbook
Set iSheet = Sheets("List") ' run time error 9 subscript out of range
With iSheet
If IsEmpty(Range("D2").Offset(1, 0)) Then
Range("D2").Copy Range("D2").Offset(1, 0)
Else
Range("D2").End(xlDown).Copy Range("D2").End(xlDown).Offset(1, 0)
End If
End With
Dim iBook2 As Workbook
Dim iSheet2 As Worksheet
Set iBook2 = ThisWorkbook
Set iSheet2 = Sheets("List")
With iSheet2
If IsEmpty(Range("E2").Offset(1, 0)) Then
Range("E2").Copy Range("E2").Offset(1, 0)
Else
Range("E2").End(xlDown).Copy Range("E2").End(xlDown).Offset(1, 0)
End If
End With
'Removes formulas above the last line
Dim ALR As Long
Dim ALR2 As Range
With Sheets("List") ' Sheet name
ALR = .Range("D" & .Rows.Count).End(xlUp).Row ' Letter in " " is the row you want code to run
Set ALR2 = .Range("D2:E" & ALR - 1) ' " " is were you choose range "A" or "A:Z" for more the one row & ALR - 1) - 1 minus one
ALR2.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
Application.CutCopyMode = False
Dim myValue As Variant
myValue = InputBox("Enter Properly Formated Parcel#", "Please")
'Step 1: Declare Your Variables.
Dim LastRow As Long
'Step 2: Capture the last used row number.
LastRow = Cells(Rows.Count, 3).End(xlUp).Row ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
'Step 3: Select the next row down
Cells(LastRow, 3).Offset(1, 0).Value = myValue ' Select ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
Dim myValue2 As Variant
myValue2 = InputBox("Requesters Name. Don't Use & or '", "Please")
'Step 1: Declare Your Variables.
Dim LastRow2 As Long
'Step 2: Capture the last used row number.
LastRow2 = Cells(Rows.Count, 6).End(xlUp).Row ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
'Step 3: Select the next row down
Cells(LastRow2, 6).Offset(1, 0).Value = myValue2 ' Select ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
Dim myValue3 As Variant
myValue3 = MsgBox("Did you recive payment? If yes click YES else just hit enter.", vbQuestion + vbYesNo + vbDefaultButton2, "Do you have check in Hand?") ' InputBox("Enter Check# if Paid Else Hit Enter", "Please", "Unpaid")
'Step 1: Declare Your Variables.
Dim LastRow3 As Long
'Step 2: Capture the last used row number.
If myValue3 = vbYes Then
LastRow3 = Cells(Rows.Count, 2).End(xlUp).Row ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
'Step 3: Select the next row down
Cells(LastRow3, 2).Offset(1, 0).Value = "PAID" ' Select ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
'Cells(LastRow3, 1).Offset(1, 0).Value = "$30"
Else
LastRow3 = Cells(Rows.Count, 2).End(xlUp).Row ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
'Step 3: Select the next row down
Cells(LastRow3, 2).Offset(1, 0).Value = "UNPAID" ' Select ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
' Cells(LastRow3, 1).Offset(1, 0).Value = "$0"
End If
Dim myValue4 As Variant
myValue4 = InputBox("Enter Date If Not Todays Date for Sent Date. Format 00/00/00", "Please", Format(Now(), "mm/dd/yy"))
'Step 1: Declare Your Variables.
Dim LastRow4 As Long
'Step 2: Capture the last used row number.
LastRow4 = Cells(Rows.Count, 8).End(xlUp).Row ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
'Step 3: Select the next row down
' Cells(LastRow4, 8).Offset(1, 0).Select ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
Cells(LastRow4, 8).Offset(1, 0).Value = myValue4 ' Select ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
'Print to PDF
Sheets(Array("Tax Cert Bill", "Tax Cert Form 2022-2021")).Select
' ChDir "T:\2022_TAX_CERTS\"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="T:\2022_TAX_CERTS\" & Sheets("Tax Cert Bill").Range("B17").Value & " - " & Sheets("Tax Cert Bill").Range("B12").Value & Format(Date, " - mm-dd-yyyy"), _
OpenAfterPublish:=True, ignoreprintareas:=False
'
'
' IE and OutLook
'Declare Variables
Dim EmailApp As Object
Dim EmailItem As Object
Dim myAttachments As Object
Dim mailAddress As String
Dim TaxCertPDF As String
Dim NorryLink As String
Dim EMail As String
' Set Variables E-Mail
Set EmailApp = CreateObject("Outlook.application")
Set EmailItem = EmailApp.CreateItem(0)
Set myAttachments = EmailItem.Attachments
' Link to copy Print Screen
NorryLink = "Home - County of Northumberland" & Sheets("Tax Cert Bill").Range("B17").Value
' E-Mail Subject Parcel - Requestor - Date.pdf
TaxCertPDF = "T:\2022_TAX_CERTS\" & Sheets("Tax Cert Bill").Range("B17").Value & " - " & Sheets("Tax Cert Bill").Range("B12").Value & Format(Date, " - mm-dd-yyyy") & ".pdf"
' Look for the mail address in the MailInfo worksheet
' mailAddress = Application.WorksheetFunction.VLookup(Worksheets("Tax Cert Bill").Range("B12").Value, Worksheets("Requestors").Range("A:A") & Worksheets("Requestors").Rows.Count), 2, False)
'EMail =index(Sheets("Requestor")A:B,MATCH(Sheets("Tax Cert Bill").Range("B12").Value,Sheets("Requestor")A:A,0),2)
' mailAddress = Sheets("Tax Cert Bill").Range("B12").Value = WorksheetFunction.Match(Sheets("Tax C").Range("C5").Value, Sheets("Data").Range("D5:D10"), 0)
' mailAddress = INDEX('Requestor'!A:B,MATCH('Tax Cert Bill'!C12,'Requestor'!A:A,0),2)
' INDEX(A1:C10,2,3)
' Look for the mail address in the MailInfo worksheet
Dim FinalResult As Variant, Table_Range As Range, LookupValue As Range
Set Table_Range = Sheets("Requestor").Range("A:B")
Set LookupValue = Sheets("Tax Cert Bill").Range("B12")
FinalResult = Application.WorksheetFunction.VLookup(LookupValue, Table_Range, 2, False)
' IE Code For Copy Paste
Dim IE As Object
Dim hwnd As Long, IECaption As String
Set IE = CreateObject("InternetExplorer.Application")
' Do Until lHwnd <> 0
' Set IE Size
IE.Visible = True
IE.Width = 624
IE.Height = 756
IE.Navigate NorryLink
Sleep 5000
'~~> Get the caption of IE
IECaption = "Home - County of Northumberland"
'~~> Get handle of IE
hwnd = FindWindow(vbNullString, IECaption)
If hwnd = 0 Then
MsgBox "IE Window Not found!"
Exit Sub
Else
'~~> Maximize IE
' ShowWindow hwnd, SW_SHOWMAXIMIZED
IE.Width = 624
IE.Height = 756
End If
Sleep 3000
DoEvents
'~~> Take a snapshot
Call keybd_event(VK_SNAPSHOT, 1, 0, 0)
'~~> Start Word
' Set wordobj = CreateObject("Word.Application")
' Set objDoc = wordobj.Documents.Add
' wordobj.Visible = True
' EmailApp.Visible = True
' Set objSelection = wordobj.Selection
' Set objSelection = EmailApp.Selection
'Paste into Word
' objSelection.Paste
' Set objSelection = EmailApp.Selection
' void keybd_event(
' keybd_event VK_LCONTROL, 0, 0, 0, keybd_event VK_V, 0, 0, 0, keybd_event VK_V, 0, KEYEVENTF_KEYUP, 0, keybd_event VK_LCONTROL, 0, KEYEVENTF_KEYUP, 0);
'keybd_event VK_LCONTROL, 0, 0, 0 'PRESS CTL
'keybd_event VK_V, 0, 0, 0 'PRESS V
'keybd_event VK_V, 0, KEYEVENTF_KEYUP, 0 'RELEASE V
'keybd_event VK_LCONTROL, 0, KEYEVENTF_KEYUP, 0 'RELEASE CTL
Dim CObj As MSForms.DataObject
Set CObj = New MSForms.DataObject
CObj.GetFromClipboard
XText = CObj.GetText(1)
' ActiveSheet.Range("B4").Value = XText
'Specify Email Items and Add Attachment
With EmailItem
.To = EMail
.Subject = Sheets("Tax Cert Bill").Range("B17").Value
.body = XText
.Attachments.Add TaxCertPDF
'.send
.Display
End With
Set EmailItem = Nothing
Set EmailApp = Nothing
Sheets("List").Select
' MsgBox "PDF has been successfully Saved in T:\2022_TAX_CERTS\Parcel# - Requester - Todays Date.pdf"
'Step 1: Declare Your Variables.
Dim LastRow5 As Long
'Step 2: Capture the last used row number.
LastRow5 = Cells(Rows.Count, 3).End(xlUp).Row ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
'Step 3: Select the next row down
Cells(LastRow5, 3).Offset(1, 0).Select ' (Rows.Count, 3) the number is row coloum A = 1, B = 2, C = 3
' Range().Value = myValue
' Dim myValue As Variant
' myValue = InputBox("Enter Properly Formated Parcel#", "Please")
ActiveWorkbook.Save 'd = True
MsgBox "done"
End Sub
it has been since i put lines
' IE Code For Copy Paste
Dim IE As Object
Dim hwnd As Long, IECaption As String
Set IE = CreateObject("InternetExplorer.Application")
' Do Until lHwnd <> 0
' Set IE Size
IE.Visible = True
IE.Width = 624
IE.Height = 756
IE.Navigate NorryLink
Sleep 5000
'~~> Get the caption of IE
IECaption = "Home - County of Northumberland"
'~~> Get handle of IE
hwnd = FindWindow(vbNullString, IECaption)
If hwnd = 0 Then
MsgBox "IE Window Not found!"
Exit Sub
Else
'~~> Maximize IE
' ShowWindow hwnd, SW_SHOWMAXIMIZED
IE.Width = 624
IE.Height = 756
End If
Sleep 3000
DoEvents
'~~> Take a snapshot
Call keybd_event(VK_SNAPSHOT, 1, 0, 0)
'~~> Start Word
' Set wordobj = CreateObject("Word.Application")
' Set objDoc = wordobj.Documents.Add
' wordobj.Visible = True
' EmailApp.Visible = True
' Set objSelection = wordobj.Selection
' Set objSelection = EmailApp.Selection
'Paste into Word
' objSelection.Paste
' Set objSelection = EmailApp.Selection
' void keybd_event(
' keybd_event VK_LCONTROL, 0, 0, 0, keybd_event VK_V, 0, 0, 0, keybd_event VK_V, 0, KEYEVENTF_KEYUP, 0, keybd_event VK_LCONTROL, 0, KEYEVENTF_KEYUP, 0);
'keybd_event VK_LCONTROL, 0, 0, 0 'PRESS CTL
'keybd_event VK_V, 0, 0, 0 'PRESS V
'keybd_event VK_V, 0, KEYEVENTF_KEYUP, 0 'RELEASE V
'keybd_event VK_LCONTROL, 0, KEYEVENTF_KEYUP, 0 'RELEASE CTL
Dim CObj As MSForms.DataObject
Set CObj = New MSForms.DataObject
CObj.GetFromClipboard
XText = CObj.GetText(1)
' ActiveSheet.Range("B4").Value = XText
else it worked right except did not paste value from clipboard in e-mail body or load webpage to screen shot. I had it loading webpage and screenshot it. pasting to word so was trying to get it to post to email body.
any help would be greatfull thanks.
