Finding F'x's answer a bit hard to comprehend (mainly because I'm not used to working with BoxData nor MessagePacket, but also since I didn't understand why identity was necessary there, I produced the following, which also has the advantage of producing a more useful (imho) stack, i.e. with the parameters and user defined functions printed as well, and the part of the stack that comes from the observation removed. I should note though F'x's method can easily be adapted to do the same.

ClearAll[withStackTraces];
SetAttributes[withStackTraces, HoldFirst];
withStackTraces::Stack = "Stack is: `1`";

withStackTraces[code_] := Internal`InheritedBlock[{Message},
  Unprotect[Message];

  Module[{inside, temp}, 
   Message[x___] /; ! TrueQ[inside] := 
    Block[{inside = True}, temp = List[x][[1]];
     If[! temp === $Off[],
      Message[x];
      Internal`InheritedBlock[{$MessagePrePrint},
       Unset[$MessagePrePrint];
       Message[withStackTraces::Stack, 
        ToString[Stack[__][[4 ;; -11]], StandardForm]]]]]];

  StackComplete@code
  ]

I started out with printing the stack but it turns out that the same message gets called several times before actually getting printed (I'm guessing that by some catch and rethrow mechanism) and so I got multiple outputs. This way, there is only one extra message generated. Comparison of output for both methods:

Finding F'x's answer a bit hard to comprehend (mainly because I'm not used to working with BoxData nor MessagePacket, but also since I didn't understand why identity was necessary there, I produced the following, which also has the advantage of producing a more useful (imho) stack, i.e. with the parameters and user defined functions printed as well, and the part of the stack that comes from the observation removed. I should note though F'x's method can easily be adapted to do the same.

ClearAll[withStackTraces];
SetAttributes[withStackTraces, HoldFirst];
withStackTraces::Stack = "Stack is: `1`";

withStackTraces[code_] := Internal`InheritedBlock[{Message},
  Unprotect[Message];

  Module[{inside, temp}, 
   Message[x___] /; ! TrueQ[inside] := 
    Block[{inside = True}, temp = List[x][[1]];
     If[! temp === $Off[],
      Message[x];
      Internal`InheritedBlock[{$MessagePrePrint},
       Unset[$MessagePrePrint];
       Message[withStackTraces::Stack, 
        ToString[Stack[__][[4 ;; -11]], StandardForm]]]]]];

  StackComplete@code
  ]

I started out with printing the stack but it turns out that the same message gets called several times before actually getting printed (I'm guessing that by some catch and rethrow mechanism) and so I got multiple outputs. This way, there is only one extra message generated. Comparison of output for both methods: