Recording a user email address would be tricky, as that would require XL to
access your email server registry and match a user name to the email. If the
macro records the Windows user name, would that be sufficient?
Sub Post_To_Department()
'
'
' Re-Coded 17-09-09 by
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Range("B5").Copy
Workbooks.Open Filename:="W:\Trade_Sales_Planning\Matt\MZ Response Boxv2",
Password:="A123456=b"
Sheets("Department").Select
Range("A1").Select
Selection.End(xlDown).Select
'Modified this line for efficiency
ActiveCell.Offset(1, 0).Value = Now
ActiveCell.Offset(1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
'Code added here
'Name added to column C
ActiveCell.Offset(0, 1).Value = Environ("UserName")
ActiveWorkbook.Save
ActiveWorkbook.Close
Windows("MoanZone.xls").Activate
Range("B5").Select
Application.CutCopyMode = False
Selection.ClearContents
ActiveWorkbook.Save
Application.DisplayAlerts = True
Application.ScreenUpdating = True
UserForm1.Show
End Sub
--
Best Regards,
Luke M
*Remember to click "yes" if this post helped you!*
"Mattlynn via OfficeKB.com" wrote:
Hi - i have taken over a survey spreadsheet in a new job.
Basically the users type their issues into a spreadsheet, click on the
relevent postbox image which has a macro assigned. It takes their message and
adds it to another spreadhseet for collation and summaries to be made.
I would like to change the macro so i can register the email that it came
from. Is this possible?
Please help if you can.
I have pasted the macro below, can you please add the additional line of code
if possible.
Many Many Thanks
Matt
Sub Post_To_Department()
'
'
' Re-Coded 17-09-09 by
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Range("B5").Copy
Workbooks.Open Filename:="W:\Trade_Sales_Planning\Matt\MZ Response Boxv2",
Password:="A123456=b"
Sheets("Department").Select
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).FormulaR1C1 = "=NOW()"
ActiveCell.Offset(1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, -1).Select
ActiveCell.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
Windows("MoanZone.xls").Activate
Range("B5").Select
Application.CutCopyMode = False
Selection.ClearContents
ActiveWorkbook.Save
Application.DisplayAlerts = True
Application.ScreenUpdating = True
UserForm1.Show
End Sub
--
Matt Lynn
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...tions/200909/1