title: VBA Code to Read the Active Program
body: <p>My hope is to have this macro continually record the name of whatever program is the current active program. I have a user form that runs a timer user a Macro that recalls itself every second. I would like it to record the name of the active window in that same macro and (if different from the last name) append that on to a descriptive string. </p>
  
  <p>I had originally used the "Active window.caption" only to learn that it doesn't apply to other programs (such as chrome, word, or Outlook), But below is a chunk of my code.</p>
  
  <pre><code>If ActiveApp &lt;&gt; ActiveWindow.Caption Then           'look at active program for name
              ActiveApp = ActiveWindow.Caption                'if the last name is not the same as the current
              aapp2 = ThisWorkbook.Sheets("bts").Range("b13").Value &amp; "|" &amp; ActiveApp &amp; ": " &amp; Format(dteElapsed, "hh:mm:ss")
              'updates the descriptive string
              ThisWorkbook.Sheets("bts").Range("b13").Value = aapp2
          End If
  </code></pre>
  
  <p>Whole Macro:</p>
  
  <pre><code>Sub timeloop()
  
  
  If ThisWorkbook.Sheets("BTS").Range("b7").Value = "" Then 'the location on theworksheet that time is stored
      ThisWorkbook.Sheets("BTS").Range("b7").Value = Time '
      ThisWorkbook.Sheets("BTS").Range("b12").Value = Date
      End If
  
  
  
      dteStart = ThisWorkbook.Sheets("BTS").Range("b7").Value
      dteFinish = Time
      DoEvents
      dteElapsed = dteFinish - dteStart
      If Not booldead = True Then 'See if form has died
  
         TimeRun.Label1 = Format(dteElapsed, "hh:mm:ss")
          If ActiveApp &lt;&gt; ActiveWindow.Caption Then           'look at active program for name
              ActiveApp = ActiveWindow.Caption                'if the last name is not the same as the current
              aapp2 = ThisWorkbook.Sheets("bts").Range("b13").Value &amp; "|" &amp; ActiveApp &amp; ": " &amp; Format(dteElapsed, "hh:mm:ss")
              'updates the descriptive string
              ThisWorkbook.Sheets("bts").Range("b13").Value = aapp2
          End If
  
  
      Else
          Exit Sub
      End If
      Alerttime = Now + TimeValue("00:00:01")
  Application.OnTime Alerttime, "TimeLoop"
  End Sub
  </code></pre>